/-
Copyright (c) 2022 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel, Kexing Ying
-/
import probability.notation
import probability.integration

/-!
# Variance of random variables

We define the variance of a real-valued random variable as `Var[X] = 𝔼[(X - 𝔼[X])^2]` (in the
`probability_theory` locale).

## Main definitions

* `probability_theory.evariance`: the variance of a real-valued random variable as a extended
  non-negative real.
* `probability_theory.variance`: the variance of a real-valued random variable as a real number.

## Main results

* `probability_theory.variance_le_expectation_sq`: the inequality `Var[X] ≤ 𝔼[X^2]`.
* `probability_theory.meas_ge_le_variance_div_sq`: Chebyshev's inequality, i.e.,
      `ℙ {ω | c ≤ |X ω - 𝔼[X]|} ≤ ennreal.of_real (Var[X] / c ^ 2)`.
* `probability_theory.meas_ge_le_evariance_div_sq`: Chebyshev's inequality formulated with
  `evariance` without requiring the random variables to be L².
* `probability_theory.indep_fun.variance_add`: the variance of the sum of two independent
  random variables is the sum of the variances.
* `probability_theory.indep_fun.variance_sum`: the variance of a finite sum of pairwise
  independent random variables is the sum of the variances.
-/

open measure_theory filter finset

noncomputable theory

open_locale big_operators measure_theory probability_theory ennreal nnreal

namespace probability_theory

/-- The `ℝ≥0∞`-valued variance of a real-valued random variable defined as the Lebesgue integral of
`(X - 𝔼[X])^2`. -/
def evariance {Ω : Type*} {m : measurable_space Ω} (X : Ω → ℝ) (μ : measure Ω) : ℝ≥0∞ :=
∫⁻ ω, ‖X ω - μ[X]‖₊^2 ∂μ

/-- The `ℝ`-valued variance of a real-valued random variable defined by applying `ennreal.to_real`
to `evariance`. -/
def variance {Ω : Type*} {m : measurable_space Ω} (X : Ω → ℝ) (μ : measure Ω) : ℝ :=
(evariance X μ).to_real

variables {Ω : Type*} {m : measurable_space Ω} {X : Ω → ℝ} {μ : measure Ω}

lemma _root_.measure_theory.mem_ℒp.evariance_lt_top [is_finite_measure μ] (hX : mem_ℒp X 2 μ) :
  evariance X μ < ∞ :=
begin
  have := ennreal.pow_lt_top (hX.sub $ mem_ℒp_const $ μ[X]).2 2,
  rw [snorm_eq_lintegral_rpow_nnnorm two_ne_zero ennreal.two_ne_top,
    ← ennreal.rpow_two] at this,
  simp only [pi.sub_apply, ennreal.to_real_bit0, ennreal.one_to_real, one_div] at this,
  rw [← ennreal.rpow_mul, inv_mul_cancel (two_ne_zero : (2 : ℝ) ≠ 0), ennreal.rpow_one] at this,
  simp_rw ennreal.rpow_two at this,
  exact this,
end

lemma evariance_eq_top [is_finite_measure μ]
  (hXm : ae_strongly_measurable X μ) (hX : ¬ mem_ℒp X 2 μ) :
  evariance X μ = ∞ :=
begin
  by_contra h,
  rw [← ne.def, ← lt_top_iff_ne_top] at h,
  have : mem_ℒp (λ ω, X ω - μ[X]) 2 μ,
  { refine ⟨hXm.sub ae_strongly_measurable_const, _⟩,
    rw snorm_eq_lintegral_rpow_nnnorm two_ne_zero ennreal.two_ne_top,
    simp only [ennreal.to_real_bit0, ennreal.one_to_real, ennreal.rpow_two, ne.def],
    exact ennreal.rpow_lt_top_of_nonneg (by simp) h.ne },
  refine hX _,
  convert this.add (mem_ℒp_const $ μ[X]),
  ext ω,
  rw [pi.add_apply, sub_add_cancel],
end

lemma evariance_lt_top_iff_mem_ℒp [is_finite_measure μ]
  (hX : ae_strongly_measurable X μ) :
  evariance X μ < ∞ ↔ mem_ℒp X 2 μ :=
begin
  refine ⟨_, measure_theory.mem_ℒp.evariance_lt_top⟩,
  contrapose,
  rw [not_lt, top_le_iff],
  exact evariance_eq_top hX
end

lemma _root_.measure_theory.mem_ℒp.of_real_variance_eq [is_finite_measure μ]
  (hX : mem_ℒp X 2 μ) :
  ennreal.of_real (variance X μ) = evariance X μ :=
by { rw [variance, ennreal.of_real_to_real], exact hX.evariance_lt_top.ne, }

include m

lemma evariance_eq_lintegral_of_real (X : Ω → ℝ) (μ : measure Ω) :
  evariance X μ = ∫⁻ ω, ennreal.of_real ((X ω - μ[X])^2) ∂μ :=
begin
  rw evariance,
  congr,
  ext1 ω,
  rw [pow_two, ← ennreal.coe_mul, ← nnnorm_mul, ← pow_two],
  congr,
  exact (real.to_nnreal_eq_nnnorm_of_nonneg $ sq_nonneg _).symm,
end

lemma _root_.measure_theory.mem_ℒp.variance_eq_of_integral_eq_zero
  (hX : mem_ℒp X 2 μ) (hXint : μ[X] = 0) :
  variance X μ = μ[X^2] :=
begin
  rw [variance, evariance_eq_lintegral_of_real, ← of_real_integral_eq_lintegral_of_real,
    ennreal.to_real_of_real];
  simp_rw [hXint, sub_zero],
  { refl },
  { exact integral_nonneg (λ ω, pow_two_nonneg _) },
  { convert hX.integrable_norm_rpow two_ne_zero ennreal.two_ne_top,
    ext ω,
    simp only [pi.sub_apply, real.norm_eq_abs, ennreal.to_real_bit0, ennreal.one_to_real,
      real.rpow_two, pow_bit0_abs] },
  { exact ae_of_all _ (λ ω, pow_two_nonneg _) }
end

lemma _root_.measure_theory.mem_ℒp.variance_eq [is_finite_measure μ]
  (hX : mem_ℒp X 2 μ) :
  variance X μ = μ[(X - (λ ω, μ[X]))^2] :=
begin
  rw [variance, evariance_eq_lintegral_of_real, ← of_real_integral_eq_lintegral_of_real,
    ennreal.to_real_of_real],
  { refl },
  { exact integral_nonneg (λ ω, pow_two_nonneg _) },
  { convert (hX.sub $ mem_ℒp_const (μ[X])).integrable_norm_rpow
      two_ne_zero ennreal.two_ne_top,
    ext ω,
    simp only [pi.sub_apply, real.norm_eq_abs, ennreal.to_real_bit0, ennreal.one_to_real,
      real.rpow_two, pow_bit0_abs] },
  { exact ae_of_all _ (λ ω, pow_two_nonneg _) }
end

@[simp]

lemma evariance_eq_zero_iff (hX : ae_measurable X μ) :
  evariance X μ = 0 ↔ X =ᵐ[μ] λ ω, μ[X] :=
begin
  rw [evariance, lintegral_eq_zero_iff'],
  split; intro hX; filter_upwards [hX] with ω hω,
  { simp only [pi.zero_apply, pow_eq_zero_iff, nat.succ_pos', ennreal.coe_eq_zero,
      nnnorm_eq_zero, sub_eq_zero] at hω,
    exact hω },
  { rw hω,
    simp },
  { measurability }
end

lemma evariance_mul (c : ℝ) (X : Ω → ℝ) (μ : measure Ω) :
  evariance (λ ω, c * X ω) μ = ennreal.of_real (c^2) * evariance X μ :=
begin
  rw [evariance, evariance, ← lintegral_const_mul' _ _ ennreal.of_real_lt_top.ne],
  congr,
  ext1 ω,
  rw [ennreal.of_real, ← ennreal.coe_pow, ← ennreal.coe_pow, ← ennreal.coe_mul],
  congr,
  rw [← sq_abs, ← real.rpow_two, real.to_nnreal_rpow_of_nonneg (abs_nonneg _), nnreal.rpow_two,
    ← mul_pow, real.to_nnreal_mul_nnnorm _ (abs_nonneg _)],
  conv_rhs { rw [← nnnorm_norm, norm_mul, norm_abs_eq_norm, ← norm_mul, nnnorm_norm, mul_sub] },
  congr,
  rw mul_comm,
  simp_rw [← smul_eq_mul, ← integral_smul_const, smul_eq_mul, mul_comm],
end

localized "notation (name := probability_theory.evariance) `eVar[` X `]` :=
  probability_theory.evariance X measure_theory.measure_space.volume" in probability_theory

@[simp] lemma variance_zero (μ : measure Ω) : variance 0 μ = 0 :=
by simp only [variance, evariance_zero, ennreal.zero_to_real]

lemma variance_nonneg (X : Ω → ℝ) (μ : measure Ω) :
  0 ≤ variance X μ :=
ennreal.to_real_nonneg

lemma variance_mul (c : ℝ) (X : Ω → ℝ) (μ : measure Ω) :
  variance (λ ω, c * X ω) μ = c^2 * variance X μ :=
begin
  rw [variance, evariance_mul, ennreal.to_real_mul, ennreal.to_real_of_real (sq_nonneg _)],
  refl,
end

lemma variance_smul (c : ℝ) (X : Ω → ℝ) (μ : measure Ω) :
  variance (c • X) μ = c^2 * variance X μ :=
variance_mul c X μ

lemma variance_smul' {A : Type*} [comm_semiring A] [algebra A ℝ]
  (c : A) (X : Ω → ℝ) (μ : measure Ω) :
  variance (c • X) μ = c^2 • variance X μ :=
begin
  convert variance_smul (algebra_map A ℝ c) X μ,
  { ext1 x, simp only [algebra_map_smul], },
  { simp only [algebra.smul_def, map_pow], }
end

localized "notation (name := probability_theory.variance) `Var[` X `]` :=
  probability_theory.variance X measure_theory.measure_space.volume" in probability_theory

omit m

variables [measure_space Ω]

lemma variance_def' [is_probability_measure (ℙ : measure Ω)]
  {X : Ω → ℝ} (hX : mem_ℒp X 2) :
  Var[X] = 𝔼[X^2] - 𝔼[X]^2 :=
begin
  rw [hX.variance_eq, sub_sq', integral_sub', integral_add'], rotate,
  { exact hX.integrable_sq },
  { convert integrable_const (𝔼[X] ^ 2),
    apply_instance },
  { apply hX.integrable_sq.add,
    convert integrable_const (𝔼[X] ^ 2),
    apply_instance },
  { exact ((hX.integrable one_le_two).const_mul 2).mul_const' _ },
  simp only [integral_mul_right, pi.pow_apply, pi.mul_apply, pi.bit0_apply, pi.one_apply,
    integral_const (integral ℙ X ^ 2), integral_mul_left (2 : ℝ), one_mul,
    variance, pi.pow_apply, measure_univ, ennreal.one_to_real, algebra.id.smul_eq_mul],
  ring,
end

lemma variance_le_expectation_sq [is_probability_measure (ℙ : measure Ω)]
  {X : Ω → ℝ} (hm : ae_strongly_measurable X ℙ) :
  Var[X] ≤ 𝔼[X^2] :=
begin
  by_cases hX : mem_ℒp X 2,
  { rw variance_def' hX,
    simp only [sq_nonneg, sub_le_self_iff] },
  rw [variance, evariance_eq_lintegral_of_real, ← integral_eq_lintegral_of_nonneg_ae],
  by_cases hint : integrable X, swap,
  { simp only [integral_undef hint, pi.pow_apply, pi.sub_apply, sub_zero] },
  { rw integral_undef,
    { exact integral_nonneg (λ a, sq_nonneg _) },
    { intro h,
      have A : mem_ℒp (X - λ (ω : Ω), 𝔼[X]) 2 ℙ := (mem_ℒp_two_iff_integrable_sq
        (hint.ae_strongly_measurable.sub ae_strongly_measurable_const)).2 h,
      have B : mem_ℒp (λ (ω : Ω), 𝔼[X]) 2 ℙ := mem_ℒp_const _,
      apply hX,
      convert A.add B,
      simp } },
  { exact ae_of_all _ (λ x, sq_nonneg _) },
  { exact (ae_measurable.pow_const (hm.ae_measurable.sub_const _) _).ae_strongly_measurable },
end

lemma evariance_def' [is_probability_measure (ℙ : measure Ω)]
  {X : Ω → ℝ} (hX : ae_strongly_measurable X ℙ) :
  eVar[X] = (∫⁻ ω, ‖X ω‖₊^2) - ennreal.of_real (𝔼[X]^2) :=
begin
  by_cases hℒ : mem_ℒp X 2,
  { rw [← hℒ.of_real_variance_eq, variance_def' hℒ, ennreal.of_real_sub _ (sq_nonneg _)],
    congr,
    simp_rw ← ennreal.coe_pow,
    rw lintegral_coe_eq_integral,
    { congr' 2 with ω,
      simp only [pi.pow_apply, nnreal.coe_pow, coe_nnnorm, real.norm_eq_abs, pow_bit0_abs] },
    { exact hℒ.abs.integrable_sq } },
  { symmetry,
    rw [evariance_eq_top hX hℒ, ennreal.sub_eq_top_iff],
    refine ⟨_, ennreal.of_real_ne_top⟩,
    rw [mem_ℒp, not_and] at hℒ,
    specialize hℒ hX,
    simp only [snorm_eq_lintegral_rpow_nnnorm two_ne_zero ennreal.two_ne_top, not_lt,
      top_le_iff, ennreal.to_real_bit0, ennreal.one_to_real, ennreal.rpow_two, one_div,
      ennreal.rpow_eq_top_iff, inv_lt_zero, inv_pos, zero_lt_bit0, zero_lt_one, and_true,
      or_iff_not_imp_left, not_and_distrib] at hℒ,
    exact hℒ (λ _, zero_le_two) }
end

/-- *Chebyshev's inequality* for `ℝ≥0∞`-valued variance. -/
theorem meas_ge_le_evariance_div_sq {X : Ω → ℝ}
  (hX : ae_strongly_measurable X ℙ) {c : ℝ≥0} (hc : c ≠ 0) :
  ℙ {ω | ↑c ≤ |X ω - 𝔼[X]|} ≤ eVar[X] / c ^ 2 :=
begin
  have A : (c : ℝ≥0∞) ≠ 0, { rwa [ne.def, ennreal.coe_eq_zero] },
  have B : ae_strongly_measurable (λ (ω : Ω), 𝔼[X]) ℙ := ae_strongly_measurable_const,
  convert meas_ge_le_mul_pow_snorm ℙ two_ne_zero ennreal.two_ne_top (hX.sub B) A,
  { ext ω,
    simp only [pi.sub_apply, ennreal.coe_le_coe, ← real.norm_eq_abs, ← coe_nnnorm,
      nnreal.coe_le_coe, ennreal.of_real_coe_nnreal] },
  { rw snorm_eq_lintegral_rpow_nnnorm two_ne_zero ennreal.two_ne_top,
    simp only [ennreal.to_real_bit0, ennreal.one_to_real, pi.sub_apply, one_div],
    rw [div_eq_mul_inv, ennreal.inv_pow, mul_comm, ennreal.rpow_two],
    congr,
    simp_rw [← ennreal.rpow_mul, inv_mul_cancel (two_ne_zero : (2 : ℝ) ≠ 0), ennreal.rpow_two,
      ennreal.rpow_one, evariance] }
end

/-- *Chebyshev's inequality* : one can control the deviation probability of a real random variable
from its expectation in terms of the variance. -/
theorem meas_ge_le_variance_div_sq [is_finite_measure (ℙ : measure Ω)]
  {X : Ω → ℝ} (hX : mem_ℒp X 2) {c : ℝ} (hc : 0 < c) :
  ℙ {ω | c ≤ |X ω - 𝔼[X]|} ≤ ennreal.of_real (Var[X] / c ^ 2) :=
begin
  rw [ennreal.of_real_div_of_pos (sq_pos_of_ne_zero _ hc.ne.symm), hX.of_real_variance_eq],
  convert @meas_ge_le_evariance_div_sq _ _ _ hX.1 (c.to_nnreal) (by simp [hc]),
  { simp only [real.coe_to_nnreal', max_le_iff, abs_nonneg, and_true] },
  { rw ennreal.of_real_pow hc.le,
    refl }
end

/-- The variance of the sum of two independent random variables is the sum of the variances. -/
theorem indep_fun.variance_add [is_probability_measure (ℙ : measure Ω)]
  {X Y : Ω → ℝ} (hX : mem_ℒp X 2) (hY : mem_ℒp Y 2) (h : indep_fun X Y) :
  Var[X + Y] = Var[X] + Var[Y] :=
calc
Var[X + Y] = 𝔼[λ a, (X a)^2 + (Y a)^2 + 2 * X a * Y a] - 𝔼[X+Y]^2 :
  by simp [variance_def' (hX.add hY), add_sq']
... = (𝔼[X^2] + 𝔼[Y^2] + 2 * 𝔼[X * Y]) - (𝔼[X] + 𝔼[Y])^2 :
begin
  simp only [pi.add_apply, pi.pow_apply, pi.mul_apply, mul_assoc],
  rw [integral_add, integral_add, integral_add, integral_mul_left],
  { exact hX.integrable one_le_two },
  { exact hY.integrable one_le_two },
  { exact hX.integrable_sq },
  { exact hY.integrable_sq },
  { exact hX.integrable_sq.add hY.integrable_sq },
  { apply integrable.const_mul,
    exact h.integrable_mul (hX.integrable one_le_two) (hY.integrable one_le_two) }
end
... = (𝔼[X^2] + 𝔼[Y^2] + 2 * (𝔼[X] * 𝔼[Y])) - (𝔼[X] + 𝔼[Y])^2 :
begin
  congr,
  exact h.integral_mul_of_integrable
    (hX.integrable one_le_two) (hY.integrable one_le_two),
end
... = Var[X] + Var[Y] :
  by { simp only [variance_def', hX, hY, pi.pow_apply], ring }

/-- The variance of a finite sum of pairwise independent random variables is the sum of the
variances. -/
theorem indep_fun.variance_sum [is_probability_measure (ℙ : measure Ω)]
  {ι : Type*} {X : ι → Ω → ℝ} {s : finset ι}
  (hs : ∀ i ∈ s, mem_ℒp (X i) 2) (h : set.pairwise ↑s (λ i j, indep_fun (X i) (X j))) :
  Var[∑ i in s, X i] = ∑ i in s, Var[X i] :=
begin
  classical,
  induction s using finset.induction_on with k s ks IH,
  { simp only [finset.sum_empty, variance_zero] },
  rw [variance_def' (mem_ℒp_finset_sum' _ hs), sum_insert ks, sum_insert ks],
  simp only [add_sq'],
  calc 𝔼[X k ^ 2 + (∑ i in s, X i) ^ 2 + 2 * X k * ∑ i in s, X i] - 𝔼[X k + ∑ i in s, X i] ^ 2
  = (𝔼[X k ^ 2] + 𝔼[(∑ i in s, X i) ^ 2] + 𝔼[2 * X k * ∑ i in s, X i])
    - (𝔼[X k] + 𝔼[∑ i in s, X i]) ^ 2 :
  begin
    rw [integral_add', integral_add', integral_add'],
    { exact mem_ℒp.integrable one_le_two (hs _ (mem_insert_self _ _)) },
    { apply integrable_finset_sum' _ (λ i hi, _),
      exact mem_ℒp.integrable one_le_two (hs _ (mem_insert_of_mem hi)) },
    { exact mem_ℒp.integrable_sq (hs _ (mem_insert_self _ _)) },
    { apply mem_ℒp.integrable_sq,
      exact mem_ℒp_finset_sum' _ (λ i hi, (hs _ (mem_insert_of_mem hi))) },
    { apply integrable.add,
      { exact mem_ℒp.integrable_sq (hs _ (mem_insert_self _ _)) },
      { apply mem_ℒp.integrable_sq,
        exact mem_ℒp_finset_sum' _ (λ i hi, (hs _ (mem_insert_of_mem hi))) } },
    { rw mul_assoc,
      apply integrable.const_mul _ (2:ℝ),
      simp only [mul_sum, sum_apply, pi.mul_apply],
      apply integrable_finset_sum _ (λ i hi, _),
      apply indep_fun.integrable_mul _
        (mem_ℒp.integrable one_le_two (hs _ (mem_insert_self _ _)))
        (mem_ℒp.integrable one_le_two (hs _ (mem_insert_of_mem hi))),
      apply h (mem_insert_self _ _) (mem_insert_of_mem hi),
      exact (λ hki, ks (hki.symm ▸ hi)) }
  end
  ... = Var[X k] + Var[∑ i in s, X i] +
    (𝔼[2 * X k * ∑ i in s, X i] - 2 * 𝔼[X k] * 𝔼[∑ i in s, X i]) :
  begin
    rw [variance_def' (hs _ (mem_insert_self _ _)),
        variance_def' (mem_ℒp_finset_sum' _ (λ i hi, (hs _ (mem_insert_of_mem hi))))],
    ring,
  end
  ... = Var[X k] + Var[∑ i in s, X i] :
  begin
    simp only [mul_assoc, integral_mul_left, pi.mul_apply, pi.bit0_apply, pi.one_apply, sum_apply,
      add_right_eq_self, mul_sum],
    rw integral_finset_sum s (λ i hi, _), swap,
    { apply integrable.const_mul _ (2:ℝ),
      apply indep_fun.integrable_mul _
        (mem_ℒp.integrable one_le_two (hs _ (mem_insert_self _ _)))
        (mem_ℒp.integrable one_le_two (hs _ (mem_insert_of_mem hi))),
      apply h (mem_insert_self _ _) (mem_insert_of_mem hi),
      exact (λ hki, ks (hki.symm ▸ hi)) },
    rw [integral_finset_sum s
      (λ i hi, (mem_ℒp.integrable one_le_two (hs _ (mem_insert_of_mem hi)))),
      mul_sum, mul_sum, ← sum_sub_distrib],
    apply finset.sum_eq_zero (λ i hi, _),
    rw [integral_mul_left, indep_fun.integral_mul', sub_self],
    { apply h (mem_insert_self _ _) (mem_insert_of_mem hi),
      exact (λ hki, ks (hki.symm ▸ hi)) },
    { exact mem_ℒp.ae_strongly_measurable (hs _ (mem_insert_self _ _)) },
    { exact mem_ℒp.ae_strongly_measurable (hs _ (mem_insert_of_mem hi)) }
  end
  ... = Var[X k] + ∑ i in s, Var[X i] :
    by rw IH (λ i hi, hs i (mem_insert_of_mem hi))
      (h.mono (by simp only [coe_insert, set.subset_insert]))
end

end probability_theory


/-
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 data.list.prime
import data.list.sort
import data.nat.gcd
import data.nat.sqrt_norm_num
import data.set.finite
import tactic.wlog
import algebra.parity

/-!
# Prime numbers

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

## Important declarations

- `nat.prime`: the predicate that expresses that a natural number `p` is prime
- `nat.primes`: the subtype of natural numbers that are prime
- `nat.min_fac n`: the minimal prime factor of a natural number `n ≠ 1`
- `nat.exists_infinite_primes`: Euclid's theorem that there exist infinitely many prime numbers.
  This also appears as `nat.not_bdd_above_set_of_prime` and `nat.infinite_set_of_prime`.
- `nat.factors n`: the prime factorization of `n`
- `nat.factors_unique`: uniqueness of the prime factorisation
- `nat.prime_iff`: `nat.prime` coincides with the general definition of `prime`
- `nat.irreducible_iff_prime`: a non-unit natural number is only divisible by `1` iff it is prime

-/

open bool subtype
open_locale nat

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`. -/
@[pp_nodot]
def prime (p : ℕ) := _root_.irreducible p

theorem _root_.irreducible_iff_nat_prime (a : ℕ) : irreducible a ↔ nat.prime a := iff.rfl

theorem not_prime_zero : ¬ prime 0
| h := h.ne_zero rfl

theorem not_prime_one : ¬ prime 1
| h := h.ne_one rfl

theorem prime.ne_zero {n : ℕ} (h : prime n) : n ≠ 0 := irreducible.ne_zero h

theorem prime.pos {p : ℕ} (pp : prime p) : 0 < p := nat.pos_of_ne_zero pp.ne_zero

theorem prime.two_le : ∀ {p : ℕ}, prime p → 2 ≤ p
| 0 h := (not_prime_zero h).elim
| 1 h := (not_prime_one h).elim
| (n+2) _ := le_add_self

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

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

lemma prime.ne_one {p : ℕ} (hp : p.prime) : p ≠ 1 :=
hp.one_lt.ne'

lemma prime.eq_one_or_self_of_dvd {p : ℕ} (pp : p.prime) (m : ℕ) (hm : m ∣ p) : m = 1 ∨ m = p :=
begin
  obtain ⟨n, hn⟩ := hm,
  have := pp.is_unit_or_is_unit hn,
  rw [nat.is_unit_iff, nat.is_unit_iff] at this,
  apply or.imp_right _ this,
  rintro rfl,
  rw [hn, mul_one]
end

theorem prime_def_lt'' {p : ℕ} : prime p ↔ 2 ≤ p ∧ ∀ m ∣ p, m = 1 ∨ m = p :=
begin
  refine ⟨λ h, ⟨h.two_le, h.eq_one_or_self_of_dvd⟩, λ h, _⟩,
  have h1 := one_lt_two.trans_le h.1,
  refine ⟨mt nat.is_unit_iff.mp h1.ne', λ a b hab, _⟩,
  simp only [nat.is_unit_iff],
  apply or.imp_right _ (h.2 a _),
  { rintro rfl,
    rw [←nat.mul_right_inj (pos_of_gt h1), ←hab, mul_one] },
  { rw hab,
    exact dvd_mul_right _ _ }
end

theorem prime_def_lt {p : ℕ} : prime p ↔ 2 ≤ p ∧ ∀ m < p, m ∣ p → m = 1 :=
prime_def_lt''.trans $
and_congr_right $ λ p2, forall_congr $ λ m,
⟨λ h l d, (h d).resolve_right (ne_of_lt l),
 λ h d, (le_of_dvd (le_of_succ_le p2) d).lt_or_eq_dec.imp_left (λ l, h l d)⟩

theorem prime_def_lt' {p : ℕ} : prime p ↔ 2 ≤ p ∧ ∀ m, 2 ≤ m → m < p → ¬ m ∣ p :=
prime_def_lt.trans $ and_congr_right $ λ p2, forall_congr $ λ m,
⟨λ h m2 l d, not_lt_of_ge m2 ((h l d).symm ▸ dec_trivial),
λ h l d, begin
  rcases m with _|_|m,
  { rw eq_zero_of_zero_dvd d at p2, revert p2, exact dec_trivial },
  { refl },
  { exact (h dec_trivial l).elim d }
end⟩

theorem prime_def_le_sqrt {p : ℕ} : prime p ↔ 2 ≤ p ∧
  ∀ m, 2 ≤ m → m ≤ sqrt p → ¬ m ∣ p :=
prime_def_lt'.trans $ and_congr_right $ λ p2,
⟨λ a m m2 l, a m m2 $ lt_of_le_of_lt l $ sqrt_lt_self p2,
 λ a, have ∀ {m k}, m ≤ k → 1 < m → p ≠ m * k, from
  λ m k mk m1 e, a m m1
    (le_sqrt.2 (e.symm ▸ nat.mul_le_mul_left m mk)) ⟨k, e⟩,
  λ m m2 l ⟨k, e⟩, begin
    cases (le_total m k) with mk km,
    { exact this mk m2 e },
    { rw [mul_comm] at e,
      refine this km (lt_of_mul_lt_mul_right _ (zero_le m)) e,
      rwa [one_mul, ← e] }
  end⟩

theorem prime_of_coprime (n : ℕ) (h1 : 1 < n) (h : ∀ m < n, m ≠ 0 → n.coprime m) : prime n :=
begin
  refine prime_def_lt.mpr ⟨h1, λ m mlt mdvd, _⟩,
  have hm : m ≠ 0,
  { rintro rfl,
    rw zero_dvd_iff at mdvd,
    exact mlt.ne' mdvd },
  exact (h m mlt hm).symm.eq_one_of_dvd mdvd,
end

section

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

  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.
  -/
local attribute [instance]
def decidable_prime_1 (p : ℕ) : decidable (prime p) :=
decidable_of_iff' _ prime_def_lt'

theorem prime_two : prime 2 := dec_trivial

end

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

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

theorem dvd_prime {p m : ℕ} (pp : prime p) : m ∣ p ↔ m = 1 ∨ m = p :=
⟨λ d, pp.eq_one_or_self_of_dvd m d, λ h, h.elim (λ e, e.symm ▸ one_dvd _) (λ e, e.symm ▸ dvd_rfl)⟩

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

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

theorem prime.not_dvd_one {p : ℕ} (pp : prime p) : ¬ p ∣ 1 :=
pp.not_dvd_one

theorem not_prime_mul {a b : ℕ} (a1 : 1 < a) (b1 : 1 < b) : ¬ prime (a * b) :=
λ h, ne_of_lt (nat.mul_lt_mul_of_pos_left b1 (lt_of_succ_lt a1)) $
by simpa using (dvd_prime_two_le h a1).1 (dvd_mul_right _ _)

lemma not_prime_mul' {a b n : ℕ} (h : a * b = n) (h₁ : 1 < a) (h₂ : 1 < b) : ¬ prime n :=
by { rw ← h, exact not_prime_mul h₁ h₂ }

lemma prime_mul_iff {a b : ℕ} :
  nat.prime (a * b) ↔ (a.prime ∧ b = 1) ∨ (b.prime ∧ a = 1) :=
by simp only [iff_self, irreducible_mul_iff, ←irreducible_iff_nat_prime, nat.is_unit_iff]

lemma prime.dvd_iff_eq {p a : ℕ} (hp : p.prime) (a1 : a ≠ 1) : a ∣ p ↔ p = a :=
begin
  refine ⟨_, by { rintro rfl, refl }⟩,
  -- rintro ⟨j, rfl⟩ does not work, due to `nat.prime` depending on the class `irreducible`
  rintro ⟨j, hj⟩,
  rw hj at hp ⊢,
  rcases prime_mul_iff.mp hp with ⟨h, rfl⟩ | ⟨h, rfl⟩,
  { exact mul_one _ },
  { exact (a1 rfl).elim }
end

section min_fac

lemma min_fac_lemma (n k : ℕ) (h : ¬ n < k * k) :
  sqrt n - k < sqrt n + 2 - k :=
(tsub_lt_tsub_iff_right $ le_sqrt.2 $ le_of_not_gt h).2 $
nat.lt_add_of_pos_right dec_trivial

/-- If `n < k * k`, then `min_fac_aux n k = n`, if `k | n`, then `min_fac_aux n k = k`.
  Otherwise, `min_fac_aux n k = min_fac_aux n (k+2)` using well-founded recursion.
  If `n` is odd and `1 < n`, then then `min_fac_aux n 3` is the smallest prime factor of `n`. -/
def min_fac_aux (n : ℕ) : ℕ → ℕ
| k :=
  if h : n < k * k then n else
  if k ∣ n then k else
  have _, from min_fac_lemma n k h,
  min_fac_aux (k + 2)
using_well_founded {rel_tac :=
  λ _ _, `[exact ⟨_, measure_wf (λ k, sqrt n + 2 - k)⟩]}

/-- Returns the smallest prime factor of `n ≠ 1`. -/
def min_fac : ℕ → ℕ
| 0 := 2
| 1 := 1
| (n+2) := if 2 ∣ n then 2 else min_fac_aux (n + 2) 3

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

theorem min_fac_eq : ∀ n, min_fac n = if 2 ∣ n then 2 else min_fac_aux n 3
| 0     := by simp
| 1     := by simp [show 2≠1, from dec_trivial]; rw min_fac_aux; refl
| (n+2) :=
  have 2 ∣ n + 2 ↔ 2 ∣ n, from
    (nat.dvd_add_iff_left (by refl)).symm,
  by simp [min_fac, this]; congr

private def min_fac_prop (n k : ℕ) :=
  2 ≤ k ∧ k ∣ n ∧ ∀ m, 2 ≤ m → m ∣ n → k ≤ m

theorem min_fac_aux_has_prop {n : ℕ} (n2 : 2 ≤ n) :
  ∀ k i, k = 2*i+3 → (∀ m, 2 ≤ m → m ∣ n → k ≤ m) → min_fac_prop n (min_fac_aux n k)
| k := λ i e a, begin
  rw min_fac_aux,
  by_cases h : n < k*k; simp [h],
  { have pp : prime n :=
      prime_def_le_sqrt.2 ⟨n2, λ m m2 l d,
        not_lt_of_ge l $ lt_of_lt_of_le (sqrt_lt.2 h) (a m m2 d)⟩,
    from ⟨n2, dvd_rfl, λ m m2 d, le_of_eq
      ((dvd_prime_two_le pp m2).1 d).symm⟩ },
  have k2 : 2 ≤ k, { subst e, exact dec_trivial },
  by_cases dk : k ∣ n; simp [dk],
  { exact ⟨k2, dk, a⟩ },
  { refine have _, from min_fac_lemma n k h,
      min_fac_aux_has_prop (k+2) (i+1)
        (by simp [e, left_distrib]) (λ m m2 d, _),
    cases nat.eq_or_lt_of_le (a m m2 d) with me ml,
    { subst me, contradiction },
    apply (nat.eq_or_lt_of_le ml).resolve_left, intro me,
    rw [← me, e] at d, change 2 * (i + 2) ∣ n at d,
    have := a _ le_rfl (dvd_of_mul_right_dvd d),
    rw e at this, exact absurd this dec_trivial }
end
using_well_founded {rel_tac :=
  λ _ _, `[exact ⟨_, measure_wf (λ k, sqrt n + 2 - k)⟩]}

theorem min_fac_has_prop {n : ℕ} (n1 : n ≠ 1) :
  min_fac_prop n (min_fac n) :=
begin
  by_cases n0 : n = 0, {simp [n0, min_fac_prop, ge]},
  have n2 : 2 ≤ n, { revert n0 n1, rcases n with _|_|_; exact dec_trivial },
  simp [min_fac_eq],
  by_cases d2 : 2 ∣ n; simp [d2],
  { exact ⟨le_rfl, d2, λ k k2 d, k2⟩ },
  { refine min_fac_aux_has_prop n2 3 0 rfl
      (λ m m2 d, (nat.eq_or_lt_of_le m2).resolve_left (mt _ d2)),
    exact λ e, e.symm ▸ d }
end

theorem min_fac_dvd (n : ℕ) : min_fac n ∣ n :=
if n1 : n = 1 then by simp [n1] else (min_fac_has_prop n1).2.1

theorem min_fac_prime {n : ℕ} (n1 : n ≠ 1) : prime (min_fac n) :=
let ⟨f2, fd, a⟩ := min_fac_has_prop n1 in
prime_def_lt'.2 ⟨f2, λ m m2 l d, not_le_of_gt l (a m m2 (d.trans fd))⟩

theorem min_fac_le_of_dvd {n : ℕ} : ∀ {m : ℕ}, 2 ≤ m → m ∣ n → min_fac n ≤ m :=
by by_cases n1 : n = 1;
  [exact λ m m2 d, n1.symm ▸ le_trans dec_trivial m2,
    exact (min_fac_has_prop n1).2.2]

theorem min_fac_pos (n : ℕ) : 0 < min_fac n :=
by by_cases n1 : n = 1;
    [exact n1.symm ▸ dec_trivial, exact (min_fac_prime n1).pos]

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

theorem le_min_fac {m n : ℕ} : n = 1 ∨ m ≤ min_fac n ↔ ∀ p, prime p → p ∣ n → m ≤ p :=
⟨λ h p pp d, h.elim
  (by rintro rfl; cases pp.not_dvd_one d)
  (λ h, le_trans h $ min_fac_le_of_dvd pp.two_le d),
  λ H, or_iff_not_imp_left.2 $ λ n1, H _ (min_fac_prime n1) (min_fac_dvd _)⟩

theorem le_min_fac' {m n : ℕ} : n = 1 ∨ m ≤ min_fac n ↔ ∀ p, 2 ≤ p → p ∣ n → m ≤ p :=
⟨λ h p (pp:1<p) d, h.elim
  (by rintro rfl; cases not_le_of_lt pp (le_of_dvd dec_trivial d))
  (λ h, le_trans h $ min_fac_le_of_dvd pp d),
  λ H, le_min_fac.2 (λ p pp d, H p pp.two_le d)⟩

theorem prime_def_min_fac {p : ℕ} : prime p ↔ 2 ≤ p ∧ min_fac p = p :=
⟨λ pp, ⟨pp.two_le,
  let ⟨f2, fd, a⟩ := min_fac_has_prop $ ne_of_gt pp.one_lt in
  ((dvd_prime pp).1 fd).resolve_left (ne_of_gt f2)⟩,
  λ ⟨p2, e⟩, e ▸ min_fac_prime (ne_of_gt p2)⟩

@[simp] lemma prime.min_fac_eq {p : ℕ} (hp : prime p) : min_fac p = p :=
(prime_def_min_fac.1 hp).2

/--
This instance is faster in the virtual machine than `decidable_prime_1`,
but slower 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.
-/
instance decidable_prime (p : ℕ) : decidable (prime p) :=
decidable_of_iff' _ prime_def_min_fac

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

lemma min_fac_le_div {n : ℕ} (pos : 0 < n) (np : ¬ prime n) : min_fac n ≤ n / min_fac n :=
match min_fac_dvd n with
| ⟨0, h0⟩     := absurd pos $ by rw [h0, mul_zero]; exact dec_trivial
| ⟨1, h1⟩     :=
  begin
    rw mul_one at h1,
    rw [prime_def_min_fac, not_and_distrib, ← h1, eq_self_iff_true, not_true, or_false,
      not_le] at np,
    rw [le_antisymm (le_of_lt_succ np) (succ_le_of_lt pos), min_fac_one, nat.div_one]
  end
| ⟨(x+2), hx⟩ :=
  begin
    conv_rhs { congr, rw hx },
    rw [nat.mul_div_cancel_left _ (min_fac_pos _)],
    exact min_fac_le_of_dvd dec_trivial ⟨min_fac n, by rwa mul_comm⟩
  end
end

/--
The square of the smallest prime factor of a composite number `n` is at most `n`.
-/
lemma min_fac_sq_le_self {n : ℕ} (w : 0 < n) (h : ¬ prime n) : (min_fac n)^2 ≤ n :=
have t : (min_fac n) ≤ (n/min_fac n) := min_fac_le_div w h,
calc
(min_fac n)^2 = (min_fac n) * (min_fac n)   : sq (min_fac n)
          ... ≤ (n/min_fac n) * (min_fac n) : nat.mul_le_mul_right (min_fac n) t
          ... ≤ n                           : div_mul_le_self n (min_fac n)

@[simp]
lemma min_fac_eq_one_iff {n : ℕ} : min_fac n = 1 ↔ n = 1 :=
begin
  split,
  { intro h,
    by_contradiction hn,
    have := min_fac_prime hn,
    rw h at this,
    exact not_prime_one this, },
  { rintro rfl, refl, }
end

@[simp]
lemma min_fac_eq_two_iff (n : ℕ) : min_fac n = 2 ↔ 2 ∣ n :=
begin
  split,
  { intro h,
    convert min_fac_dvd _,
    rw h, },
  { intro h,
    have ub := min_fac_le_of_dvd (le_refl 2) h,
    have lb := min_fac_pos n,
    apply ub.eq_or_lt.resolve_right (λ h', _),
    have := le_antisymm (nat.succ_le_of_lt lb) (lt_succ_iff.mp h'),
    rw [eq_comm, nat.min_fac_eq_one_iff] at this,
    subst this,
    exact not_lt_of_le (le_of_dvd zero_lt_one h) one_lt_two }
end

end min_fac

theorem exists_dvd_of_not_prime {n : ℕ} (n2 : 2 ≤ n) (np : ¬ prime n) :
  ∃ m, m ∣ n ∧ m ≠ 1 ∧ m ≠ n :=
⟨min_fac n, min_fac_dvd _, ne_of_gt (min_fac_prime (ne_of_gt n2)).one_lt,
  ne_of_lt $ (not_prime_iff_min_fac_lt n2).1 np⟩

theorem exists_dvd_of_not_prime2 {n : ℕ} (n2 : 2 ≤ n) (np : ¬ prime n) :
  ∃ m, m ∣ n ∧ 2 ≤ m ∧ m < n :=
⟨min_fac n, min_fac_dvd _, (min_fac_prime (ne_of_gt n2)).two_le,
  (not_prime_iff_min_fac_lt n2).1 np⟩

theorem exists_prime_and_dvd {n : ℕ} (hn : n ≠ 1) : ∃ p, prime p ∧ p ∣ n :=
⟨min_fac n, min_fac_prime hn, min_fac_dvd _⟩

/-- Euclid's theorem on the **infinitude of primes**.
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 :=
let p := min_fac (n! + 1) in
have f1 : n! + 1 ≠ 1, from ne_of_gt $ succ_lt_succ $ factorial_pos _,
have pp : prime p, from min_fac_prime f1,
have np : n ≤ p, from le_of_not_ge $ λ h,
  have h₁ : p ∣ n!, from dvd_factorial (min_fac_pos _) h,
  have h₂ : p ∣ 1, from (nat.dvd_add_iff_right h₁).2 (min_fac_dvd _),
  pp.not_dvd_one h₂,
⟨p, np, pp⟩

/-- A version of `nat.exists_infinite_primes` using the `bdd_above` predicate. -/
lemma not_bdd_above_set_of_prime : ¬ bdd_above {p | prime p} :=
begin
  rw not_bdd_above_iff,
  intro n,
  obtain ⟨p, hi, hp⟩ := exists_infinite_primes n.succ,
  exact ⟨p, hp, hi⟩,
end

/-- A version of `nat.exists_infinite_primes` using the `set.infinite` predicate. -/
lemma infinite_set_of_prime : {p | prime p}.infinite :=
set.infinite_of_not_bdd_above not_bdd_above_set_of_prime

lemma prime.eq_two_or_odd {p : ℕ} (hp : prime p) : p = 2 ∨ p % 2 = 1 :=
p.mod_two_eq_zero_or_one.imp_left
  (λ h, ((hp.eq_one_or_self_of_dvd 2 (dvd_of_mod_eq_zero h)).resolve_left dec_trivial).symm)

lemma prime.eq_two_or_odd' {p : ℕ} (hp : prime p) : p = 2 ∨ odd p :=
or.imp_right (λ h, ⟨p / 2, (div_add_mod p 2).symm.trans (congr_arg _ h)⟩) hp.eq_two_or_odd

lemma prime.even_iff {p : ℕ} (hp : prime p) : even p ↔ p = 2 :=
by rw [even_iff_two_dvd, prime_dvd_prime_iff_eq prime_two hp, eq_comm]

/-- A prime `p` satisfies `p % 2 = 1` if and only if `p ≠ 2`. -/
lemma prime.mod_two_eq_one_iff_ne_two {p : ℕ} [fact p.prime] : p % 2 = 1 ↔ p ≠ 2 :=
begin
  refine ⟨λ h hf, _, (nat.prime.eq_two_or_odd $ fact.out p.prime).resolve_left⟩,
  rw hf at h,
  simpa using h,
end

theorem coprime_of_dvd {m n : ℕ} (H : ∀ k, prime k → k ∣ m → ¬ k ∣ n) : coprime m n :=
begin
  rw [coprime_iff_gcd_eq_one],
  by_contra g2,
  obtain ⟨p, hp, hpdvd⟩ := exists_prime_and_dvd g2,
  apply H p hp; apply dvd_trans hpdvd,
  { exact gcd_dvd_left _ _ },
  { exact gcd_dvd_right _ _ }
end

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

theorem factors_lemma {k} : (k+2) / min_fac (k+2) < k+2 :=
div_lt_self dec_trivial (min_fac_prime dec_trivial).one_lt

/-- `factors n` is the prime factorization of `n`, listed in increasing order. -/
def factors : ℕ → list ℕ
| 0 := []
| 1 := []
| n@(k+2) :=
  let m := min_fac n in have n / m < n := factors_lemma,
  m :: factors (n / m)

@[simp] lemma factors_zero : factors 0 = [] := by rw factors
@[simp] lemma factors_one : factors 1 = [] := by rw factors

lemma prime_of_mem_factors : ∀ {n p}, p ∈ factors n → prime p
| 0       := by simp
| 1       := by simp
| n@(k+2) := λ p h,
  let m := min_fac n in have n / m < n := factors_lemma,
  have h₁ : p = m ∨ p ∈ (factors (n / m)) :=
    (list.mem_cons_iff _ _ _).1 (by rwa [factors] at h),
  or.cases_on h₁ (λ h₂, h₂.symm ▸ min_fac_prime dec_trivial)
    prime_of_mem_factors

lemma pos_of_mem_factors {n p : ℕ} (h : p ∈ factors n) : 0 < p :=
prime.pos (prime_of_mem_factors h)

lemma prod_factors : ∀ {n}, n ≠ 0 → list.prod (factors n) = n
| 0       := by simp
| 1       := by simp
| n@(k+2) := λ h,
  let m := min_fac n in have n / m < n := factors_lemma,
  show (factors n).prod = n, from
  have h₁ : n / m ≠ 0 := λ h,
    have n = 0 * m := (nat.div_eq_iff_eq_mul_left (min_fac_pos _) (min_fac_dvd _)).1 h,
    by rw zero_mul at this; exact (show k + 2 ≠ 0, from dec_trivial) this,
  by rw [factors, list.prod_cons, prod_factors h₁, nat.mul_div_cancel' (min_fac_dvd _)]

lemma factors_prime {p : ℕ} (hp : nat.prime p) : p.factors = [p] :=
begin
  have : p = (p - 2) + 2 := (tsub_eq_iff_eq_add_of_le hp.two_le).mp rfl,
  rw [this, nat.factors],
  simp only [eq.symm this],
  have : nat.min_fac p = p := (nat.prime_def_min_fac.mp hp).2,
  split,
  { exact this, },
  { simp only [this, nat.factors, nat.div_self (nat.prime.pos hp)], },
end

lemma factors_chain : ∀ {n a}, (∀ p, prime p → p ∣ n → a ≤ p) → list.chain (≤) a (factors n)
| 0       := λ a h, by simp
| 1       := λ a h, by simp
| n@(k+2) := λ a h,
  let m := min_fac n in have n / m < n := factors_lemma,
  begin
    rw factors,
    refine list.chain.cons ((le_min_fac.2 h).resolve_left dec_trivial) (factors_chain _),
    exact λ p pp d, min_fac_le_of_dvd pp.two_le (d.trans $ div_dvd_of_dvd $ min_fac_dvd _),
  end

lemma factors_chain_2 (n) : list.chain (≤) 2 (factors n) := factors_chain $ λ p pp _, pp.two_le

lemma factors_chain' (n) : list.chain' (≤) (factors n) :=
@list.chain'.tail _ _ (_::_) (factors_chain_2 _)

lemma factors_sorted (n : ℕ) : list.sorted (≤) (factors n) :=
(list.chain'_iff_pairwise (@le_trans _ _)).1 (factors_chain' _)

/-- `factors` can be constructed inductively by extracting `min_fac`, for sufficiently large `n`. -/
lemma factors_add_two (n : ℕ) :
  factors (n+2) = min_fac (n+2) :: factors ((n+2) / min_fac (n+2)) :=
by rw factors

@[simp]
lemma factors_eq_nil (n : ℕ) : n.factors = [] ↔ n = 0 ∨ n = 1 :=
begin
  split; intro h,
  { rcases n with (_ | _ | n),
    { exact or.inl rfl },
    { exact or.inr rfl },
    { rw factors at h, injection h }, },
  { rcases h with (rfl | rfl),
    { exact factors_zero },
    { exact factors_one }, }
end

lemma eq_of_perm_factors {a b : ℕ} (ha : a ≠ 0) (hb : b ≠ 0) (h : a.factors ~ b.factors) : a = b :=
by simpa [prod_factors ha, prod_factors hb] using list.perm.prod_eq h

theorem prime.coprime_iff_not_dvd {p n : ℕ} (pp : prime p) : coprime p n ↔ ¬ p ∣ n :=
⟨λ co d, pp.not_dvd_one $ co.dvd_of_dvd_mul_left (by simp [d]),
 λ nd, coprime_of_dvd $ λ m m2 mp, ((prime_dvd_prime_iff_eq m2 pp).1 mp).symm ▸ nd⟩

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

theorem prime.not_coprime_iff_dvd {m n : ℕ} :
  ¬ coprime m n ↔ ∃p, prime p ∧ p ∣ m ∧ p ∣ n :=
begin
  apply iff.intro,
  { intro h,
    exact ⟨min_fac (gcd m n), min_fac_prime h,
      ((min_fac_dvd (gcd m n)).trans (gcd_dvd_left m n)),
      ((min_fac_dvd (gcd m n)).trans (gcd_dvd_right m n))⟩ },
  { intro h,
    cases h with p hp,
    apply nat.not_coprime_of_dvd_of_dvd (prime.one_lt hp.1) hp.2.1 hp.2.2 }
end

theorem prime.dvd_mul {p m n : ℕ} (pp : prime p) : p ∣ m * n ↔ p ∣ m ∨ p ∣ n :=
⟨λ H, or_iff_not_imp_left.2 $ λ h,
  (pp.coprime_iff_not_dvd.2 h).dvd_of_dvd_mul_left H,
 or.rec (λ h : p ∣ m, h.mul_right _) (λ h : p ∣ n, h.mul_left _)⟩

theorem prime.not_dvd_mul {p m n : ℕ} (pp : prime p)
  (Hm : ¬ p ∣ m) (Hn : ¬ p ∣ n) : ¬ p ∣ m * n :=
mt pp.dvd_mul.1 $ by simp [Hm, Hn]

theorem prime_iff {p : ℕ} : p.prime ↔ _root_.prime p :=
⟨λ h, ⟨h.ne_zero, h.not_unit, λ a b, h.dvd_mul.mp⟩, prime.irreducible⟩

theorem irreducible_iff_prime {p : ℕ} : irreducible p ↔ _root_.prime p :=
by rw [←prime_iff, prime]

theorem prime.dvd_of_dvd_pow {p m n : ℕ} (pp : prime p) (h : p ∣ m^n) : p ∣ m :=
begin
  induction n with n IH,
  { exact pp.not_dvd_one.elim h },
  { rw pow_succ at h, exact (pp.dvd_mul.1 h).elim id IH }
end

lemma prime.pow_not_prime {x n : ℕ} (hn : 2 ≤ n) : ¬ (x ^ n).prime :=
λ hp, (hp.eq_one_or_self_of_dvd x $ dvd_trans ⟨x, sq _⟩ (pow_dvd_pow _ hn)).elim
  (λ hx1, hp.ne_one $ hx1.symm ▸ one_pow _)
  (λ hxn, lt_irrefl x $ calc x = x ^ 1 : (pow_one _).symm
     ... < x ^ n : nat.pow_right_strict_mono (hxn.symm ▸ hp.two_le) hn
     ... = x : hxn.symm)

lemma prime.pow_not_prime' {x : ℕ} : ∀ {n : ℕ}, n ≠ 1 → ¬ (x ^ n).prime
| 0     := λ _, not_prime_one
| 1     := λ h, (h rfl).elim
| (n+2) := λ _, prime.pow_not_prime le_add_self

lemma prime.eq_one_of_pow {x n : ℕ} (h : (x ^ n).prime) : n = 1 :=
not_imp_not.mp prime.pow_not_prime' h

lemma prime.pow_eq_iff {p a k : ℕ} (hp : p.prime) : a ^ k = p ↔ a = p ∧ k = 1 :=
begin
  refine ⟨λ h, _, λ h, by rw [h.1, h.2, pow_one]⟩,
  rw ←h at hp,
  rw [←h, hp.eq_one_of_pow, eq_self_iff_true, and_true, pow_one],
end

lemma pow_min_fac {n k : ℕ} (hk : k ≠ 0) : (n^k).min_fac = n.min_fac :=
begin
  rcases eq_or_ne n 1 with rfl | hn,
  { simp },
  have hnk : n ^ k ≠ 1 := λ hk', hn ((pow_eq_one_iff hk).1 hk'),
  apply (min_fac_le_of_dvd (min_fac_prime hn).two_le ((min_fac_dvd n).pow hk)).antisymm,
  apply min_fac_le_of_dvd (min_fac_prime hnk).two_le
    ((min_fac_prime hnk).dvd_of_dvd_pow (min_fac_dvd _)),
end

lemma prime.pow_min_fac {p k : ℕ} (hp : p.prime) (hk : k ≠ 0) : (p^k).min_fac = p :=
by rw [pow_min_fac hk, hp.min_fac_eq]

lemma prime.mul_eq_prime_sq_iff {x y p : ℕ} (hp : p.prime) (hx : x ≠ 1) (hy : y ≠ 1) :
  x * y = p ^ 2 ↔ x = p ∧ y = p :=
⟨λ h, have pdvdxy : p ∣ x * y, by rw h; simp [sq],
begin
  wlog := hp.dvd_mul.1 pdvdxy using x y,
  cases case with a ha,
  have hap : a ∣ p, from ⟨y, by rwa [ha, sq,
        mul_assoc, nat.mul_right_inj hp.pos, eq_comm] at h⟩,
  exact ((nat.dvd_prime hp).1 hap).elim
    (λ _, by clear_aux_decl; simp [*, sq, nat.mul_right_inj hp.pos] at *
      {contextual := tt})
    (λ _, by clear_aux_decl; simp [*, sq, mul_comm, mul_assoc,
      nat.mul_right_inj hp.pos, nat.mul_right_eq_self_iff hp.pos] at *
      {contextual := tt})
end,
λ ⟨h₁, h₂⟩, h₁.symm ▸ h₂.symm ▸ (sq _).symm⟩

lemma prime.dvd_factorial : ∀ {n p : ℕ} (hp : prime p), p ∣ n! ↔ p ≤ n
| 0 p hp := iff_of_false hp.not_dvd_one (not_le_of_lt hp.pos)
| (n+1) p hp := begin
  rw [factorial_succ, hp.dvd_mul, prime.dvd_factorial hp],
  exact ⟨λ h, h.elim (le_of_dvd (succ_pos _)) le_succ_of_le,
    λ h, (_root_.lt_or_eq_of_le h).elim (or.inr ∘ le_of_lt_succ)
      (λ h, or.inl $ by rw h)⟩
end

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

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

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

theorem coprime_or_dvd_of_prime {p} (pp : prime p) (i : ℕ) : coprime p i ∨ p ∣ i :=
by rw [pp.dvd_iff_not_coprime]; apply em

lemma coprime_of_lt_prime {n p} (n_pos : 0 < n) (hlt : n < p) (pp : prime p) :
  coprime p n :=
(coprime_or_dvd_of_prime pp n).resolve_right $ λ h, lt_le_antisymm hlt (le_of_dvd n_pos h)

lemma eq_or_coprime_of_le_prime {n p} (n_pos : 0 < n) (hle : n ≤ p) (pp : prime p) :
  p = n ∨ coprime p n :=
hle.eq_or_lt.imp eq.symm (λ h, coprime_of_lt_prime n_pos h pp)

theorem dvd_prime_pow {p : ℕ} (pp : prime p) {m i : ℕ} : i ∣ (p^m) ↔ ∃ k ≤ m, i = p^k :=
by simp_rw [dvd_prime_pow (prime_iff.mp pp) m, associated_eq_eq]

lemma prime.dvd_mul_of_dvd_ne {p1 p2 n : ℕ} (h_neq : p1 ≠ p2) (pp1 : prime p1) (pp2 : prime p2)
  (h1 : p1 ∣ n) (h2 : p2 ∣ n) : (p1 * p2 ∣ n) :=
coprime.mul_dvd_of_dvd_of_dvd ((coprime_primes pp1 pp2).mpr h_neq) h1 h2

/--
If `p` is prime,
and `a` doesn't divide `p^k`, but `a` does divide `p^(k+1)`
then `a = p^(k+1)`.
-/
lemma 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) :=
begin
  obtain ⟨l, ⟨h, rfl⟩⟩ := (dvd_prime_pow pp).1 h₂,
  congr,
  exact le_antisymm h (not_le.1 ((not_congr (pow_dvd_pow_iff_le_right (prime.one_lt pp))).1 h₁)),
end

lemma ne_one_iff_exists_prime_dvd : ∀ {n}, n ≠ 1 ↔ ∃ p : ℕ, p.prime ∧ p ∣ n
| 0 := by simpa using (Exists.intro 2 nat.prime_two)
| 1 := by simp [nat.not_prime_one]
| (n+2) :=
let a := n+2 in
let ha : a ≠ 1 := nat.succ_succ_ne_one n in
begin
  simp only [true_iff, ne.def, not_false_iff, ha],
  exact ⟨a.min_fac, nat.min_fac_prime ha, a.min_fac_dvd⟩,
end

lemma eq_one_iff_not_exists_prime_dvd {n : ℕ} : n = 1 ↔ ∀ p : ℕ, p.prime → ¬p ∣ n :=
by simpa using not_iff_not.mpr ne_one_iff_exists_prime_dvd

section
open list

lemma mem_factors_iff_dvd {n p : ℕ} (hn : n ≠ 0) (hp : prime p) : p ∈ factors n ↔ p ∣ n :=
⟨λ h, prod_factors hn ▸ list.dvd_prod h,
  λ h, mem_list_primes_of_dvd_prod
    (prime_iff.mp hp)
    (λ p h, prime_iff.mp (prime_of_mem_factors h))
    ((prod_factors hn).symm ▸ h)⟩

lemma dvd_of_mem_factors {n p : ℕ} (h : p ∈ n.factors) : p ∣ n :=
begin
  rcases n.eq_zero_or_pos with rfl | hn,
  { exact dvd_zero p },
  { rwa ←mem_factors_iff_dvd hn.ne' (prime_of_mem_factors h) }
end

lemma mem_factors {n p} (hn : n ≠ 0) : p ∈ factors n ↔ prime p ∧ p ∣ n :=
⟨λ h, ⟨prime_of_mem_factors h, dvd_of_mem_factors h⟩,
 λ ⟨hprime, hdvd⟩, (mem_factors_iff_dvd hn hprime).mpr hdvd⟩

lemma le_of_mem_factors {n p : ℕ} (h : p ∈ n.factors) : p ≤ n :=
begin
  rcases n.eq_zero_or_pos with rfl | hn,
  { rw factors_zero at h, cases h },
  { exact le_of_dvd hn (dvd_of_mem_factors h) },
end

/-- **Fundamental theorem of arithmetic**-/
lemma factors_unique {n : ℕ} {l : list ℕ} (h₁ : prod l = n) (h₂ : ∀ p ∈ l, prime p) :
  l ~ factors n :=
begin
  refine perm_of_prod_eq_prod _ _ _,
  { rw h₁,
    refine (prod_factors _).symm,
    rintro rfl,
    rw prod_eq_zero_iff at h₁,
    exact prime.ne_zero (h₂ 0 h₁) rfl },
  { simp_rw ←prime_iff, exact h₂ },
  { simp_rw ←prime_iff, exact (λ p, prime_of_mem_factors) },
end

lemma prime.factors_pow {p : ℕ} (hp : p.prime) (n : ℕ) :
  (p ^ n).factors = list.repeat p n :=
begin
  symmetry,
  rw ← list.repeat_perm,
  apply nat.factors_unique (list.prod_repeat p n),
  intros q hq,
  rwa eq_of_mem_repeat hq,
end

lemma eq_prime_pow_of_unique_prime_dvd {n p : ℕ} (hpos : n ≠ 0)
  (h : ∀ {d}, nat.prime d → d ∣ n → d = p) :
  n = p ^ n.factors.length :=
begin
  set k := n.factors.length,
  rw [←prod_factors hpos, ←prod_repeat p k,
    eq_repeat_of_mem (λ d hd, h (prime_of_mem_factors hd) (dvd_of_mem_factors hd))],
end

/-- For positive `a` and `b`, the prime factors of `a * b` are the union of those of `a` and `b` -/
lemma perm_factors_mul {a b : ℕ} (ha : a ≠ 0) (hb : b ≠ 0) :
  (a * b).factors ~ a.factors ++ b.factors :=
begin
  refine (factors_unique _ _).symm,
  { rw [list.prod_append, prod_factors ha, prod_factors hb] },
  { intros p hp,
    rw list.mem_append at hp,
    cases hp;
    exact prime_of_mem_factors hp },
end

/-- For coprime `a` and `b`, the prime factors of `a * b` are the union of those of `a` and `b` -/
lemma perm_factors_mul_of_coprime {a b : ℕ} (hab : coprime a b) :
  (a * b).factors ~ a.factors ++ b.factors :=
begin
  rcases a.eq_zero_or_pos with rfl | ha,
  { simp [(coprime_zero_left _).mp hab] },
  rcases b.eq_zero_or_pos with rfl | hb,
  { simp [(coprime_zero_right _).mp hab] },
  exact perm_factors_mul ha.ne' hb.ne',
end

lemma factors_sublist_right {n k : ℕ} (h : k ≠ 0) : n.factors <+ (n * k).factors :=
begin
  cases n,
  { rw zero_mul },
  apply sublist_of_subperm_of_sorted _ (factors_sorted _) (factors_sorted _),
  rw (perm_factors_mul n.succ_ne_zero h).subperm_left,
  exact (sublist_append_left _ _).subperm,
end

lemma factors_sublist_of_dvd {n k : ℕ} (h : n ∣ k) (h' : k ≠ 0) : n.factors <+ k.factors :=
begin
  obtain ⟨a, rfl⟩ := h,
  exact factors_sublist_right (right_ne_zero_of_mul h'),
end

lemma factors_subset_right {n k : ℕ} (h : k ≠ 0) : n.factors ⊆ (n * k).factors :=
(factors_sublist_right h).subset

lemma factors_subset_of_dvd {n k : ℕ} (h : n ∣ k) (h' : k ≠ 0) : n.factors ⊆ k.factors :=
(factors_sublist_of_dvd h h').subset

lemma dvd_of_factors_subperm {a b : ℕ} (ha : a ≠ 0) (h : a.factors <+~ b.factors) : a ∣ b :=
begin
  rcases b.eq_zero_or_pos with rfl | hb,
  { exact dvd_zero _ },
  rcases a with (_|_|a),
  { exact (ha rfl).elim },
  { exact one_dvd _ },
  use (b.factors.diff a.succ.succ.factors).prod,
  nth_rewrite 0 ←nat.prod_factors ha,
  rw [←list.prod_append,
      list.perm.prod_eq $ list.subperm_append_diff_self_of_count_le $ list.subperm_ext_iff.mp h,
      nat.prod_factors hb.ne']
end

end

lemma 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 :=
have hpd : p^(k+l)*p ∣ m*n, by rwa pow_succ' at hpmn,
have hpd2 : p ∣ (m*n) / p ^ (k+l), from dvd_div_of_mul_dvd hpd,
have hpd3 : p ∣ (m*n) / (p^k * p^l), by simpa [pow_add] using hpd2,
have hpd4 : p ∣ (m / p^k) * (n / p^l), by simpa [nat.div_mul_div_comm hpm hpn] using hpd3,
have hpd5 : p ∣ (m / p^k) ∨ p ∣ (n / p^l), from (prime.dvd_mul p_prime).1 hpd4,
suffices p^k*p ∣ m ∨ p^l*p ∣ n, by rwa [pow_succ', pow_succ'],
  hpd5.elim
    (assume : p ∣ m / p ^ k, or.inl $ mul_dvd_of_dvd_div hpm this)
    (assume : p ∣ n / p ^ l, or.inr $ mul_dvd_of_dvd_div hpn this)

lemma prime_iff_prime_int {p : ℕ} : p.prime ↔ _root_.prime (p : ℤ) :=
⟨λ hp, ⟨int.coe_nat_ne_zero_iff_pos.2 hp.pos, mt int.is_unit_iff_nat_abs_eq.1 hp.ne_one,
  λ a b h, by rw [← int.dvd_nat_abs, int.coe_nat_dvd, int.nat_abs_mul, hp.dvd_mul] at h;
    rwa [← int.dvd_nat_abs, int.coe_nat_dvd, ← int.dvd_nat_abs, int.coe_nat_dvd]⟩,
  λ hp, nat.prime_iff.2 ⟨int.coe_nat_ne_zero.1 hp.1,
      mt nat.is_unit_iff.1 $ λ h, by simpa [h, not_prime_one] using hp,
    λ a b, by simpa only [int.coe_nat_dvd, (int.coe_nat_mul _ _).symm] using hp.2.2 a b⟩⟩

/-- The type of prime numbers -/
def primes := {p : ℕ // p.prime}

namespace primes

instance : has_repr nat.primes := ⟨λ p, repr p.val⟩
instance inhabited_primes : inhabited primes := ⟨⟨2, prime_two⟩⟩

instance coe_nat : has_coe nat.primes ℕ := ⟨subtype.val⟩

theorem coe_nat_inj (p q : nat.primes) : (p : ℕ) = (q : ℕ) → p = q :=
λ h, subtype.eq h

end primes

instance monoid.prime_pow {α : Type*} [monoid α] : has_pow α primes := ⟨λ x p, x^p.val⟩

end nat

/-! ### Primality prover -/

open norm_num

namespace tactic
namespace norm_num

lemma is_prime_helper (n : ℕ)
  (h₁ : 1 < n) (h₂ : nat.min_fac n = n) : nat.prime n :=
nat.prime_def_min_fac.2 ⟨h₁, h₂⟩

lemma min_fac_bit0 (n : ℕ) : nat.min_fac (bit0 n) = 2 :=
by simp [nat.min_fac_eq, show 2 ∣ bit0 n, by simp [bit0_eq_two_mul n]]

/-- A predicate representing partial progress in a proof of `min_fac`. -/
def min_fac_helper (n k : ℕ) : Prop :=
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 :=
pos_iff_ne_zero.2 $ λ e,
by rw e at h; exact not_le_of_lt (nat.bit1_lt h.1) h.2

lemma min_fac_ne_bit0 {n k : ℕ} : nat.min_fac (bit1 n) ≠ bit0 k :=
begin
  rw bit0_eq_two_mul,
  refine (λ e, absurd ((nat.dvd_add_iff_right _).2
    (dvd_trans ⟨_, e⟩ (nat.min_fac_dvd _))) _); simp
end

lemma min_fac_helper_0 (n : ℕ) (h : 0 < n) : min_fac_helper n 1 :=
begin
  refine ⟨zero_lt_one, lt_of_le_of_ne _ min_fac_ne_bit0.symm⟩,
  rw nat.succ_le_iff,
  refine lt_of_le_of_ne (nat.min_fac_pos _) (λ e, nat.not_prime_one _),
  rw e,
  exact nat.min_fac_prime (nat.bit1_lt h).ne',
end

lemma 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' :=
begin
  rw ← e,
  refine ⟨nat.succ_pos _,
    (lt_of_le_of_ne (lt_of_le_of_ne _ _ : k+1+k < _)
      min_fac_ne_bit0.symm : bit0 (k+1) < _)⟩,
  { rw add_right_comm, exact h.2 },
  { rw add_right_comm, exact np.symm }
end

lemma 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' :=
begin
  refine min_fac_helper_1 e _ h,
  intro e₁, rw ← e₁ at np,
  exact np (nat.min_fac_prime $ ne_of_gt $ nat.bit1_lt h.n_pos)
end

lemma 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' :=
begin
  refine min_fac_helper_1 e _ h,
  refine mt _ (ne_of_gt c0), intro e₁,
  rw [← nc, ← nat.dvd_iff_mod_eq_zero, ← e₁],
  apply nat.min_fac_dvd
end

lemma 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 :=
by { rw ← nat.dvd_iff_mod_eq_zero at hd,
  exact le_antisymm (nat.min_fac_le_of_dvd (nat.bit1_lt h.1) hd) h.2 }

lemma 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 :=
begin
  refine (nat.prime_def_min_fac.1 (nat.prime_def_le_sqrt.2
    ⟨nat.bit1_lt h.n_pos, _⟩)).2,
  rw ← e at hd,
  intros m m2 hm md,
  have := le_trans h.2 (le_trans (nat.min_fac_le_of_dvd m2 md) hm),
  rw nat.le_sqrt at this,
  exact not_le_of_lt hd this
end

/-- Given `e` a natural numeral and `d : nat` a factor of it, return `⊢ ¬ prime e`. -/
meta def prove_non_prime (e : expr) (n d₁ : ℕ) : tactic expr :=
do let e₁ := reflect d₁,
  c ← mk_instance_cache `(nat),
  (c, p₁) ← prove_lt_nat c `(1) e₁,
  let d₂ := n / d₁, let e₂ := reflect d₂,
  (c, e', p) ← prove_mul_nat c e₁ e₂,
  guard (e' =ₐ e),
  (c, p₂) ← prove_lt_nat c `(1) e₂,
  return $ `(@nat.not_prime_mul').mk_app [e₁, e₂, e, p, p₁, p₂]

/-- Given `a`,`a1 := bit1 a`, `n1` the value of `a1`, `b` and `p : min_fac_helper a b`,
  returns `(c, ⊢ min_fac a1 = c)`. -/
meta def prove_min_fac_aux (a a1 : expr) (n1 : ℕ) :
  instance_cache → expr → expr → tactic (instance_cache × expr × expr)
| ic b p := do
  k ← b.to_nat,
  let k1 := bit1 k,
  let b1 := `(bit1:ℕ→ℕ).mk_app [b],
  if n1 < k1*k1 then do
    (ic, e', p₁) ← prove_mul_nat ic b1 b1,
    (ic, p₂) ← prove_lt_nat ic a1 e',
    return (ic, a1, `(min_fac_helper_5).mk_app [a, b, e', p₁, p₂, p])
  else let d := k1.min_fac in
  if to_bool (d < k1) then do
    let k' := k+1, let e' := reflect k',
    (ic, p₁) ← prove_succ ic b e',
    p₂ ← prove_non_prime b1 k1 d,
    prove_min_fac_aux ic e' $ `(min_fac_helper_2).mk_app [a, b, e', p₁, p₂, p]
  else do
    let nc := n1 % k1,
    (ic, c, pc) ← prove_div_mod ic a1 b1 tt,
    if nc = 0 then
      return (ic, b1, `(min_fac_helper_4).mk_app [a, b, pc, p])
    else do
      (ic, p₀) ← prove_pos ic c,
      let k' := k+1, let e' := reflect k',
      (ic, p₁) ← prove_succ ic b e',
      prove_min_fac_aux ic e' $ `(min_fac_helper_3).mk_app [a, b, e', c, p₁, pc, p₀, p]

/-- Given `a` a natural numeral, returns `(b, ⊢ min_fac a = b)`. -/
meta def prove_min_fac (ic : instance_cache) (e : expr) : tactic (instance_cache × expr × expr) :=
match match_numeral e with
| match_numeral_result.zero := return (ic, `(2:ℕ), `(nat.min_fac_zero))
| match_numeral_result.one := return (ic, `(1:ℕ), `(nat.min_fac_one))
| match_numeral_result.bit0 e := return (ic, `(2), `(min_fac_bit0).mk_app [e])
| match_numeral_result.bit1 e := do
  n ← e.to_nat,
  c ← mk_instance_cache `(nat),
  (c, p) ← prove_pos c e,
  let a1 := `(bit1:ℕ→ℕ).mk_app [e],
  prove_min_fac_aux e a1 (bit1 n) c `(1) (`(min_fac_helper_0).mk_app [e, p])
| _ := failed
end

/-- A partial proof of `factors`. Asserts that `l` is a sorted list of primes, lower bounded by a
prime `p`, which multiplies to `n`. -/
def factors_helper (n p : ℕ) (l : list ℕ) : Prop :=
p.prime → list.chain (≤) p l ∧ (∀ a ∈ l, nat.prime a) ∧ list.prod l = n

lemma factors_helper_nil (a : ℕ) : factors_helper 1 a [] :=
λ pa, ⟨list.chain.nil, by rintro _ ⟨⟩, list.prod_nil⟩

lemma factors_helper_cons' (n m a b : ℕ) (l : list ℕ)
  (h₁ : b * m = n) (h₂ : a ≤ b) (h₃ : nat.min_fac b = b)
  (H : factors_helper m b l) : factors_helper n a (b :: l) :=
λ pa,
  have pb : b.prime, from nat.prime_def_min_fac.2 ⟨le_trans pa.two_le h₂, h₃⟩,
  let ⟨f₁, f₂, f₃⟩ := H pb in
  ⟨list.chain.cons h₂ f₁, λ c h, h.elim (λ e, e.symm ▸ pb) (f₂ _),
   by rw [list.prod_cons, f₃, h₁]⟩

lemma factors_helper_cons (n m a b : ℕ) (l : list ℕ)
  (h₁ : b * m = n) (h₂ : a < b) (h₃ : nat.min_fac b = b)
  (H : factors_helper m b l) : factors_helper n a (b :: l) :=
factors_helper_cons' _ _ _ _ _ h₁ h₂.le h₃ H

lemma factors_helper_sn (n a : ℕ) (h₁ : a < n) (h₂ : nat.min_fac n = n) : factors_helper n a [n] :=
factors_helper_cons _ _ _ _ _ (mul_one _) h₁ h₂ (factors_helper_nil _)

lemma factors_helper_same (n m a : ℕ) (l : list ℕ) (h : a * m = n)
  (H : factors_helper m a l) : factors_helper n a (a :: l) :=
λ pa, factors_helper_cons' _ _ _ _ _ h le_rfl (nat.prime_def_min_fac.1 pa).2 H pa

lemma factors_helper_same_sn (a : ℕ) : factors_helper a a [a] :=
factors_helper_same _ _ _ _ (mul_one _) (factors_helper_nil _)

lemma factors_helper_end (n : ℕ) (l : list ℕ) (H : factors_helper n 2 l) : nat.factors n = l :=
let ⟨h₁, h₂, h₃⟩ := H nat.prime_two in
have _, from (list.chain'_iff_pairwise (@le_trans _ _)).1 (@list.chain'.tail _ _ (_::_) h₁),
(list.eq_of_perm_of_sorted (nat.factors_unique h₃ h₂) this (nat.factors_sorted _)).symm

/-- Given `n` and `a` natural numerals, returns `(l, ⊢ factors_helper n a l)`. -/
meta def prove_factors_aux :
  instance_cache → expr → expr → ℕ → ℕ → tactic (instance_cache × expr × expr)
| c en ea n a :=
  let b := n.min_fac in
  if b < n then do
    let m := n / b,
    (c, em) ← c.of_nat m,
    if b = a then do
      (c, _, p₁) ← prove_mul_nat c ea em,
      (c, l, p₂) ← prove_factors_aux c em ea m a,
      pure (c, `(%%ea::%%l:list ℕ), `(factors_helper_same).mk_app [en, em, ea, l, p₁, p₂])
    else do
      (c, eb) ← c.of_nat b,
      (c, _, p₁) ← prove_mul_nat c eb em,
      (c, p₂) ← prove_lt_nat c ea eb,
      (c, _, p₃) ← prove_min_fac c eb,
      (c, l, p₄) ← prove_factors_aux c em eb m b,
      pure (c, `(%%eb::%%l : list ℕ),
        `(factors_helper_cons).mk_app [en, em, ea, eb, l, p₁, p₂, p₃, p₄])
  else if b = a then
    pure (c, `([%%ea] : list ℕ), `(factors_helper_same_sn).mk_app [ea])
  else do
    (c, p₁) ← prove_lt_nat c ea en,
    (c, _, p₂) ← prove_min_fac c en,
    pure (c, `([%%en] : list ℕ), `(factors_helper_sn).mk_app [en, ea, p₁, p₂])

/-- Evaluates the `prime` and `min_fac` functions. -/
@[norm_num] meta def eval_prime : expr → tactic (expr × expr)
| `(nat.prime %%e) := do
  n ← e.to_nat,
  match n with
  | 0 := false_intro `(nat.not_prime_zero)
  | 1 := false_intro `(nat.not_prime_one)
  | _ := let d₁ := n.min_fac in
    if d₁ < n then prove_non_prime e n d₁ >>= false_intro
    else do
      let e₁ := reflect d₁,
      c ← mk_instance_cache `(ℕ),
      (c, p₁) ← prove_lt_nat c `(1) e₁,
      (c, e₁, p) ← prove_min_fac c e,
      true_intro $ `(is_prime_helper).mk_app [e, p₁, p]
  end
| `(nat.min_fac %%e) := do
  ic ← mk_instance_cache `(ℕ),
  prod.snd <$> prove_min_fac ic e
| `(nat.factors %%e) := do
  n ← e.to_nat,
  match n with
  | 0 := pure (`(@list.nil ℕ), `(nat.factors_zero))
  | 1 := pure (`(@list.nil ℕ), `(nat.factors_one))
  | _ := do
    c ← mk_instance_cache `(ℕ),
    (c, l, p) ← prove_factors_aux c e `(2) n 2,
    pure (l, `(factors_helper_end).mk_app [e, l, p])
  end
| _ := failed

end norm_num
end tactic

namespace nat

theorem prime_three : prime 3 := by norm_num

instance fact_prime_two : fact (prime 2) := ⟨prime_two⟩

instance fact_prime_three : fact (prime 3) := ⟨prime_three⟩

end nat

namespace nat

lemma mem_factors_mul {a b : ℕ} (ha : a ≠ 0) (hb : b ≠ 0) {p : ℕ} :
  p ∈ (a * b).factors ↔ p ∈ a.factors ∨ p ∈ b.factors :=
begin
  rw [mem_factors (mul_ne_zero ha hb), mem_factors ha, mem_factors hb, ←and_or_distrib_left],
  simpa only [and.congr_right_iff] using prime.dvd_mul
end

/-- If `a`, `b` are positive, the prime divisors of `a * b` are the union of those of `a` and `b` -/
lemma factors_mul_to_finset {a b : ℕ} (ha : a ≠ 0) (hb : b ≠ 0) :
  (a * b).factors.to_finset = a.factors.to_finset ∪ b.factors.to_finset :=
(list.to_finset.ext $ λ x, (mem_factors_mul ha hb).trans list.mem_union.symm).trans $
  list.to_finset_union _ _

lemma pow_succ_factors_to_finset (n k : ℕ) :
  (n^(k+1)).factors.to_finset = n.factors.to_finset :=
begin
  rcases eq_or_ne n 0 with rfl | hn,
  { simp },
  induction k with k ih,
  { simp },
  rw [pow_succ, factors_mul_to_finset hn (pow_ne_zero _ hn), ih, finset.union_idempotent]
end

lemma pow_factors_to_finset (n : ℕ) {k : ℕ} (hk : k ≠ 0) :
  (n^k).factors.to_finset = n.factors.to_finset :=
begin
  cases k,
  { simpa using hk },
  rw pow_succ_factors_to_finset
end

/-- The only prime divisor of positive prime power `p^k` is `p` itself -/
lemma prime_pow_prime_divisor {p k : ℕ} (hk : k ≠ 0) (hp : prime p) :
  (p^k).factors.to_finset = {p} :=
by simp [pow_factors_to_finset p hk, factors_prime hp]

/-- The sets of factors of coprime `a` and `b` are disjoint -/
lemma coprime_factors_disjoint {a b : ℕ} (hab : a.coprime b) : list.disjoint a.factors b.factors :=
begin
  intros q hqa hqb,
  apply not_prime_one,
  rw ←(eq_one_of_dvd_coprimes hab (dvd_of_mem_factors hqa) (dvd_of_mem_factors hqb)),
  exact prime_of_mem_factors hqa
end

lemma mem_factors_mul_of_coprime {a b : ℕ} (hab : coprime a b) (p : ℕ):
  p ∈ (a * b).factors ↔ p ∈ a.factors ∪ b.factors :=
begin
  rcases a.eq_zero_or_pos with rfl | ha,
  { simp [(coprime_zero_left _).mp hab] },
  rcases b.eq_zero_or_pos with rfl | hb,
  { simp [(coprime_zero_right _).mp hab] },
  rw [mem_factors_mul ha.ne' hb.ne', list.mem_union]
end

lemma factors_mul_to_finset_of_coprime {a b : ℕ} (hab : coprime a b) :
  (a * b).factors.to_finset = a.factors.to_finset ∪ b.factors.to_finset :=
(list.to_finset.ext $ mem_factors_mul_of_coprime hab).trans $ list.to_finset_union _ _

open list

/-- If `p` is a prime factor of `a` then `p` is also a prime factor of `a * b` for any `b > 0` -/
lemma mem_factors_mul_left {p a b : ℕ} (hpa : p ∈ a.factors) (hb : b ≠ 0) : p ∈ (a*b).factors :=
begin
  rcases eq_or_ne a 0 with rfl | ha,
  { simpa using hpa },
  apply (mem_factors_mul ha hb).2 (or.inl hpa),
end

/-- If `p` is a prime factor of `b` then `p` is also a prime factor of `a * b` for any `a > 0` -/
lemma mem_factors_mul_right {p a b : ℕ} (hpb : p ∈ b.factors) (ha : a ≠ 0) : p ∈ (a*b).factors :=
by { rw mul_comm, exact mem_factors_mul_left hpb ha }

lemma eq_two_pow_or_exists_odd_prime_and_dvd (n : ℕ) :
  (∃ k : ℕ, n = 2 ^ k) ∨ ∃ p, nat.prime p ∧ p ∣ n ∧ odd p :=
(eq_or_ne n 0).elim
  (λ hn, (or.inr ⟨3, prime_three, hn.symm ▸ dvd_zero 3, ⟨1, rfl⟩⟩))
  (λ hn, or_iff_not_imp_right.mpr
    (λ H, ⟨n.factors.length, eq_prime_pow_of_unique_prime_dvd hn
      (λ p hprime hdvd, hprime.eq_two_or_odd'.resolve_right
        (λ hodd, H ⟨p, hprime, hdvd, hodd⟩))⟩))

end nat

namespace int
lemma prime_two : prime (2 : ℤ) := nat.prime_iff_prime_int.mp nat.prime_two
lemma prime_three : prime (3 : ℤ) := nat.prime_iff_prime_int.mp nat.prime_three
end int

section
open finset
/-- Exactly `n / p` naturals in `[1, n]` are multiples of `p`. -/
lemma card_multiples (n p : ℕ) : card ((range n).filter (λ e, p ∣ e + 1)) = n / p :=
begin
  induction n with n hn,
  { rw [nat.zero_div, range_zero, filter_empty, card_empty] },
  { rw [nat.succ_div, add_ite, add_zero, range_succ, filter_insert, apply_ite card,
      card_insert_of_not_mem (mem_filter.not.mpr (not_and_of_not_left _ not_mem_range_self)), hn] }
end
end


/-
Copyright (c) 2022 Ivan Sadofschi Costa. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Ivan Sadofschi Costa
-/
import topology.order
import topology.sets.opens
import topology.continuous_function.basic

/-!
# Any T0 space embeds in a product of copies of the Sierpinski space.

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

We consider `Prop` with the Sierpinski topology. If `X` is a topological space, there is a
continuous map `product_of_mem_opens` from `X` to `opens X → Prop` which is the product of the maps
`X → Prop` given by `x ↦ x ∈ u`.

The map `product_of_mem_opens` is always inducing. Whenever `X` is T0, `product_of_mem_opens` is
also injective and therefore an embedding.
-/

noncomputable theory

namespace topological_space

lemma eq_induced_by_maps_to_sierpinski (X : Type*) [t : topological_space X] :
  t = ⨅ (u : opens X), sierpinski_space.induced (∈ u) :=
begin
  apply le_antisymm,
  { rw [le_infi_iff],
    exact λ u, continuous.le_induced (is_open_iff_continuous_mem.mp u.2) },
  { intros u h,
    rw ← generate_from_Union_is_open,
    apply is_open_generate_from_of_mem,
    simp only [set.mem_Union, set.mem_set_of_eq, is_open_induced_iff],
    exact ⟨⟨u, h⟩, {true}, is_open_singleton_true, by simp [set.preimage]⟩ },
end

variables (X : Type*) [topological_space X]

/--
The continuous map from `X` to the product of copies of the Sierpinski space, (one copy for each
open subset `u` of `X`). The `u` coordinate of `product_of_mem_opens x` is given by `x ∈ u`.
-/
def product_of_mem_opens : C(X, opens X → Prop) :=
{ to_fun := λ x u, x ∈ u,
  continuous_to_fun := continuous_pi_iff.2 (λ u, continuous_Prop.2 u.is_open) }

lemma product_of_mem_opens_inducing : inducing (product_of_mem_opens X) :=
begin
  convert inducing_infi_to_pi (λ (u : opens X) (x : X), x ∈ u),
  apply eq_induced_by_maps_to_sierpinski,
end

lemma product_of_mem_opens_injective [t0_space X] : function.injective (product_of_mem_opens X) :=
begin
  intros x1 x2 h,
  apply inseparable.eq,
  rw [←inducing.inseparable_iff (product_of_mem_opens_inducing X), h],
 end

theorem product_of_mem_opens_embedding [t0_space X] : embedding (product_of_mem_opens X) :=
embedding.mk (product_of_mem_opens_inducing X) (product_of_mem_opens_injective X)

end topological_space


import tactic

noncomputable theory
open_locale classical
universe u

/-?

# The Maths

A groupoid (G, *) is a gyrogroup if its binary operation satisfies the following axioms:

* In G there is at least one element e called a left identity with e * a = a for all a ∈ G.
* For each a ∈ G there is an element a⁻¹ in G called a left inverse of a with a⁻¹ * a = e.
* For any a, b, c in G there exists a unique element gyr[a, b]c in G such that the binary operation obeys the left gyroassociative law: a{\displaystyle \oplus }\oplus (b{\displaystyle \oplus }\oplus c) = (a{\displaystyle \oplus }\oplus b){\displaystyle \oplus }\oplus gyr[a, b]c
The map gyr[a, b]:G → G given by c → gyr[a, b]c is an automorphism of the groupoid (G, {\displaystyle \oplus }\oplus ). That is gyr[a, b] is a member of Aut(G, {\displaystyle \oplus }\oplus ) and the automorphism gyr[a, b] of G is called the gyroautomorphism of G generated by a, b in G. The operation gyr:G × G → Aut(G, {\displaystyle \oplus }\oplus ) is called the gyrator of G.
The gyroautomorphism gyr[a, b] has the left loop property gyr[a, b] = gyr[a{\displaystyle \oplus }\oplus b, b]
The first pair of axioms are like the group axioms. The last pair present the gyrator axioms and the middle axiom links the two pairs.

Since a gyrogroup has inverses and an identity it qualifies as a quasigroup and a loop.

Gyrogroups are a generalization of groups. Every group is an example of a gyrogroup with gyr defined as the identity map.
-/

/-?
Magma, which may be called a groupoid by different people.

A group is a magma (G, +) whose binary operation satisfies the following axioms.
* In G there is at least one element, 0, called a left identity, satisfying
                                  *(G1) 0+a=a for all a ∈ G*.
* There is an element 0 ∈ G satisfying axion (G1) such that for each a ∈ G there is
an element −a ∈ G, called a left inverse of a, satisfying
                                  *(G2) −a + a = 0*
* Moreover, the binary operation obeys the associative law
                                 *(G3) (a + b) + c = a + (b + c) for all a, b, c ∈ G*.

-/
class magma_not (S : Type) extends has_add S, has_neg S, has_zero S :=
-- axiom 1: ∀ a ∃ 0, 0 + a = a
(zero_add: ∀ (a : S), 0 + a = a)
-- axiom 2: ∀ a ∃ -a, -a + a = 0
(add_left_neg: ∀ (a : S), -a + a = 0)
-- axiom 3: ∀ a b c, (a + b) + c = a + (b + c)
(add_magma_assoc: ∀ (a b c : S), (a + b) + c = a + (b + c))

/-?
A loop is a magma (S, +) with an identity element in
which each of the two equations a + x = b and y + a = b for the unknowns x
and y possesses a unique solution.
-/

class loop (S : Type) extends has_add S, has_neg S, has_zero S :=
-- axiom 1: ∀ a ∃ 0, 0 + a = a
(zero_add: ∀ (a : S), 0 + a = a)
-- axiom 2: ∀ a ∃ -a, -a + a = 0
(add_left_neg: ∀ (a : S), -a + a = 0)
(add_right_neg: ∀ (a : S), a + -a = 0)
-- axiom 3: ∀ a b c, (a + b) + c = a + (b + c)
(add_magma_assoc: ∀ (a b c : S), (a + b) + c = a + (b + c))

class has_gyrop        (α : Type u) := (gyrop : α → α → α)
class has_subgyrop     (α : Type u) := (subgyrop : α → α → α)
class has_neggyrop     (α : Type u) := (neggyrop : α → α)
class has_cogyrop      (α : Type u) := (cogyrop : α → α → α)
class has_subcogyrop      (α : Type u) := (subcogyrop : α → α → α)
class has_negcogyrop      (α : Type u) := (negcogyrop : α → α)

#print notation -

infix ` ⊙ `:75 := has_gyrop.gyrop
infix ` ⊝ `:65 := has_subgyrop.subgyrop
prefix ` ⊝ `:75 := has_neggyrop.neggyrop
infix ` ⊞ `:80 := has_cogyrop.cogyrop
infix ` ⊟ `:80 := has_subcogyrop.subcogyrop -- what a long name
prefix ` ⊟ `:85 := has_negcogyrop.negcogyrop

#print notation ⊝

--#check a ⊝ b


/-
Copyright (c) 2021 Gabriel Moise. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Gabriel Moise.
-/

import algebra.big_operators.basic
import combinatorics.simple_graph.basic
import data.fintype.basic
import data.sym2
import linear_algebra.matrix

/-!
# Incidence matrices

This module defines the incidence matrix `inc_matrix` of an undirected graph `simple_graph`, and provides
theorems and lemmas connecting graph properties to computational properties of the matrix. It also
defines the notion of `orientation` for a `simple_graph`, picking a direction for each undirected
edge in the graph.

## Main definitions

* `inc_matrix` is the incidence matrix `M` of a `simple_graph` with coefficients in a given ring R.
* `orientation` is a structure that defines a choice of direction on the edges of a `simple_graph`.
* `dir_inc_matrix` is the directed incidence matrix `N(o)` of a `simple_graph` with
respect to a given `orientation`.

## Main statements

1. ∑ e : E, M i e * M j e = 1, for any two adjacent vertices i and j.
2. M i e * M j e = 0, for any two distinct non-adjacent vertices i, j and edge e.
3. Every element from M is idempotent.
4. For any vertex i, the sum on the ith row of M is equal to the degree of i.
5. (N(o) i e) ^ 2 = M i e, for any orientation o, vertex i and edge e.
6. For any adjacent vertices i j and edge e, N(o) i e * N(o) j e = if e = (i,j) then -1 else 0.
7. For any non-adjacent distinct vertices i j and edge e, N(o) i e * N(o) j e = 0.
8. (xᵀ ⬝ N) e = x head(e) - x tail(e).
-/

open_locale big_operators matrix
open finset matrix simple_graph sym2

universe u
variables {R : Type u} [ring R] [nontrivial R] [decidable_eq R]

@[simp]
lemma ite_prod_one_zero {P Q : Prop} [decidable P] [decidable Q] :
  (ite P 1 0) * (ite Q 1 0) = ite (P ∧ Q) (1 : R) 0 :=
by { by_cases h : P; simp [h] }

lemma fintype.card_coe_filter {α : Sort*} {s t : set α} [fintype s] [fintype t]
  [decidable_pred (λ (x : t), (x : α) ∈ s)] (h : s ⊆ t) :
  fintype.card s = finset.card (finset.filter (λ (x : t), (x : α) ∈ s) finset.univ) :=
begin
  refine finset.card_congr _ _ _ _,
  { rintros ⟨e, he⟩ he',
    exact ⟨e, h he⟩ },
  { rintros ⟨e, he⟩ he',
    simpa only [true_and, finset.mem_univ, finset.mem_filter] using he},
  { rintros ⟨e1, he1⟩ ⟨e2, he2⟩ he1' he2' hr,
    ext,
    simp only [subtype.mk_eq_mk] at hr,
    simp only [hr] },
  { rintros ⟨e, he⟩ he',
    use [e],
    { simpa only [true_and, finset.mem_univ, finset.mem_filter] using he'},
    { simp only [finset.mem_univ, exists_prop_of_true] } }
end

namespace simple_graph

universe v
variables {V : Type v} [fintype V] (G : simple_graph V) (R) [decidable_rel G.adj] [decidable_eq V]

-- ## Incidence matrix M

/-- `inc_matrix G R` is the matrix `M` such that `M i e = 1` if vertex `i` is an
endpoint of the edge `e` in the simple graph `G`, otherwise `M i j = 0`. -/
def inc_matrix : matrix V G.edge_set R
| i e := if (e : sym2 V) ∈ G.incidence_set i then 1 else 0

@[simp]
lemma inc_matrix_apply {i : V} {e : G.edge_set} :
  G.inc_matrix R i e = if (e : sym2 V) ∈ G.incidence_set i then 1 else 0 := rfl

lemma inc_matrix_def : G.inc_matrix R = λ i e, ite ((e : sym2 V) ∈ G.incidence_set i) 1 0 :=
by { ext, simp only [inc_matrix_apply] }

-- ## Relation between inc_matrix elements and incidence_set property

@[simp]
lemma inc_matrix_zero {i : V} {e : G.edge_set} : G.inc_matrix R i e = 0 ↔ e.val ∉ G.incidence_set i :=
by simp only [inc_matrix, ite_eq_right_iff, subtype.val_eq_coe, ← decidable.not_imp_not,
              forall_true_left, not_false_iff, one_ne_zero]

@[simp]
lemma inc_matrix_one {i : V} {e : G.edge_set} : G.inc_matrix R i e = 1 ↔ e.val ∈ G.incidence_set i :=
by simp only [inc_matrix, ite_eq_left_iff, subtype.val_eq_coe, ← decidable.not_imp_not,
              set.not_not_mem, forall_true_left, not_false_iff, zero_ne_one]

-- ## One - zero properties

@[simp]
lemma inc_matrix_not_zero {i : V} {e : G.edge_set} : ¬ G.inc_matrix R i e = 0 ↔ G.inc_matrix R i e = 1 :=
by simp only [inc_matrix_zero, inc_matrix_one, set.not_not_mem]

@[simp]
lemma inc_matrix_not_one {i : V} {e : G.edge_set} : ¬ G.inc_matrix R i e = 1 ↔ G.inc_matrix R i e = 0 :=
by simp only [inc_matrix_zero, inc_matrix_one]

lemma inc_matrix_zero_or_one {i : V} {e : G.edge_set} :
  G.inc_matrix R i e = 0 ∨ G.inc_matrix R i e = 1 :=
by { rw [inc_matrix_zero, inc_matrix_one], exact (em (e.val ∈ G.incidence_set i)).symm }

@[simp]
lemma inc_matrix_elements_product_one {i j : V} {e : G.edge_set} :
  G.inc_matrix R i e * G.inc_matrix R j e = 1 ↔ G.inc_matrix R i e = 1 ∧ G.inc_matrix R j e = 1 :=
begin
  cases G.inc_matrix_zero_or_one R with H₀ H₁,
  { rw H₀, simp only [if_t_t, mul_boole, inc_matrix_apply, zero_ne_one, false_and] },
  { rw H₁, simp only [true_and, mul_boole, inc_matrix_apply, eq_self_iff_true] }
end

-- ## Helping lemmas for edges

@[simp]
lemma edge_val_equiv {e₁ e₂ : G.edge_set} : e₁.val = e₂.val ↔ e₁ = e₂ :=
begin
  split,
  { exact subtype.eq },
  { intro hyp,
    rw hyp }
end

lemma edge_val_in_set {e : G.edge_set} : e.val ∈ G.edge_set :=
by simp only [subtype.coe_prop, subtype.val_eq_coe]

lemma edge_set_ne {u v : V} {e: G.edge_set} (h : e.val = ⟦(u, v)⟧) : u ≠ v :=
begin
  apply G.ne_of_adj,
  simp only [← G.mem_edge_set, ← h, edge_val_in_set],
end

lemma incidence_equiv {i : V} {e : G.edge_set} : e.val ∈ G.incidence_set i ↔ i ∈ e.val :=
by simp only [incidence_set, true_and, set.mem_sep_eq, edge_val_in_set]

lemma incidence_set_iff_any_vertex {i u v : V} (h : ⟦(u, v)⟧ ∈ G.edge_set) :
  ⟦(u, v)⟧ ∈ G.incidence_set i ↔ i = u ∨ i = v :=
by simp only [← mem_iff, h, incidence_set, true_and, set.mem_sep_eq]

lemma edge_in_two_incidence_sets {i j : V} {e : sym2 V} (H_ne : i ≠ j) :
  e ∈ G.incidence_set i ∧ e ∈ G.incidence_set j → e = ⟦(i, j)⟧ :=
begin
  refine quotient.rec_on_subsingleton e (λ p, _),
  rcases p with ⟨v, w⟩,
  rw eq_iff,
  rintros ⟨⟨_, H_i⟩, ⟨_, H_j⟩⟩,
  cases (mem_iff.mp H_i) with H_i₁ H_i₂;
  cases (mem_iff.mp H_j) with H_j₁ H_j₂,
  { exfalso, apply H_ne, rw [H_i₁, H_j₁] }, -- i = v, j = v
  { left, use [H_i₁.symm, H_j₂.symm] },     -- i = v, j = w
  { right, use [H_j₁.symm, H_i₂.symm] },    -- i = w, j = v
  { exfalso, apply H_ne, rw [H_i₂, H_j₂] }  -- i = w, j = w
end

lemma mem_incidence_sets_iff_eq_of_adj {i j : V} {e : sym2 V} (h : G.adj i j) :
  e ∈ G.incidence_set i ∧ e ∈ G.incidence_set j ↔ e = ⟦(i, j)⟧ :=
begin
  refine quotient.rec_on_subsingleton e (λ p, _),
  rcases p with ⟨v, w⟩,
  rw eq_iff,
  simp only [incidence_set],
  tidy,
end

lemma adj_iff_exists_edge_val {i j : V} : G.adj i j ↔ ∃ (e : G.edge_set), e.val = ⟦(i, j)⟧ :=
by simp only [mem_edge_set, exists_prop, set_coe.exists, exists_eq_right, subtype.coe_mk]

-- 1. ∑ e : E, M i e * M j e = 1, where i and j are adjacent.
lemma adj_sum_of_prod_inc_one {i j : V} (H_adj : G.adj i j) :
  ∑ (e : G.edge_set), G.inc_matrix R i e * G.inc_matrix R j e = (1 : R) :=
begin
  simp only [inc_matrix_apply, ite_prod_one_zero, G.mem_incidence_sets_iff_eq_of_adj H_adj,
             sum_boole, ← subtype.val_eq_coe],
  rw adj_iff_exists_edge_val at H_adj,
  rcases H_adj with ⟨e, H_e⟩,
  simp only [← H_e, edge_val_equiv],
  have H : filter (λ (x : G.edge_set), x = e) univ = {e},
  { ext, simp only [true_and, mem_filter, mem_univ, mem_singleton] },
  simp only [H, filter_congr_decidable, nat.cast_one, card_singleton]
end

-- 2. M i e * M j e = 0, where i, j distinct non-adjacent vertices, e an edge.
lemma inc_matrix_prod_non_adj {i j : V} {e : G.edge_set} (Hne : i ≠ j) (H_non_adj : ¬ G.adj i j) :
  G.inc_matrix R i e * G.inc_matrix R j e = 0 :=
begin
  by_cases H₁ : G.inc_matrix R i e = 0,
  { rw [H₁, zero_mul] },
  { rw [inc_matrix_not_zero, inc_matrix_one] at H₁,
    by_cases H₂ : G.inc_matrix R j e = 0,
    { rw [H₂, mul_zero] },
    { rw [inc_matrix_not_zero, inc_matrix_one] at H₂,
      exfalso,
      apply H_non_adj,
      rw [← mem_edge_set, ← G.edge_in_two_incidence_sets Hne ⟨H₁, H₂⟩],
      exact G.edge_val_in_set } }
end

-- 3. (M i e) ^ 2 = M i e; with i a vertex, e an edge.
@[simp]
lemma inc_matrix_element_power_id {i : V} {e : G.edge_set} :
  (G.inc_matrix R i e) * (G.inc_matrix R i e) = G.inc_matrix R i e :=
by simp [inc_matrix_apply]

-- 4. degree(i) = ∑ e : E, M i e; where i is a vertex.
lemma degree_equals_sum_of_incidence_row {i : V} : (G.degree i : R) = ∑ (e : G.edge_set), G.inc_matrix R i e :=
begin
  rw [inc_matrix_def, ←card_incidence_set_eq_degree],
  simp only [sum_boole, nat.cast_inj, fintype.card_coe_filter (G.incidence_set_subset i)],
end

-- ## Orientations

/-- Define an `orientation` on the undirected graph G as a structure that defines (consistently)
for each edge a `head` and a `tail`. -/
@[ext]
structure orientation (G : simple_graph V) :=
(head : G.edge_set → V)
(tail : G.edge_set → V)
(consistent : ∀ e : G.edge_set, e.val = ⟦(head(e),tail(e))⟧)

-- ## Directed Incidence Matrix N(o)

/-- A `directed incidence matrix` N(o) is defined with respect to the orientation of the edges and is defined to be
`1` for entries (`i`,`e`) where `i` is the head of `e`, `-1` where `i` is the tail of `e`, and `0` otherwise. -/
def dir_inc_matrix (o : orientation G) : matrix V G.edge_set R :=
λ i e, if i = o.head e then 1 else (if i = o.tail e then (-1 : R) else 0)

variables {o : orientation G}

@[simp]
lemma dir_inc_matrix_apply {i : V} {e : G.edge_set} :
  G.dir_inc_matrix R o i e = if i = o.head e then 1 else (if i = o.tail e then (-1 : R) else 0) := rfl

lemma head_neq_tail {e : G.edge_set} : o.head(e) ≠ o.tail(e) :=
by exact G.edge_set_ne (o.consistent e)

@[simp]
lemma dir_inc_matrix_head {i : V} {e : G.edge_set} (H_head : i = o.head e) :
  G.dir_inc_matrix R o i e = 1 :=
by simp only [H_head, if_true, eq_self_iff_true, dir_inc_matrix_apply]

@[simp]
lemma dir_inc_matrix_tail {i : V} {e : G.edge_set} (H_tail : i = o.tail e) :
  G.dir_inc_matrix R o i e = -1 :=
by simp only [H_tail, dir_inc_matrix, (G.head_neq_tail).symm, if_false, if_true, eq_self_iff_true]

@[simp]
lemma dir_inc_matrix_zero {i : V} {e : G.edge_set} :
  G.dir_inc_matrix R o i e = 0 ↔ i ≠ o.head e ∧ i ≠ o.tail e :=
begin
  by_cases H₁ : i = o.head e,
  { simp only [dir_inc_matrix, H₁, if_true, eq_self_iff_true, not_true,
               ne.def, one_ne_zero, false_and] },
  { by_cases H₂ : i = o.tail e,
    { simp only [H₂, dir_inc_matrix_tail, eq_self_iff_true, not_true,
                 ne.def, neg_eq_zero, one_ne_zero, and_false] },
    { simp only [H₁, H₂, eq_self_iff_true, if_false, ne.def,
                 not_false_iff, and_self, dir_inc_matrix_apply] } }
end

@[simp]
lemma dir_inc_matrix_non_zero {i : V} {e : G.edge_set} :
  ¬ G.dir_inc_matrix R o i e = 0 ↔ i = o.head e ∨ i = o.tail e :=
begin
  by_cases H₁ : i = o.head e,
  { simp only [H₁, if_true, true_or, eq_self_iff_true, ne.def,
               not_false_iff, one_ne_zero, dir_inc_matrix_apply] },
  { by_cases H₂ : i = o.tail e,
    { simp only [H₂, dir_inc_matrix_tail, eq_self_iff_true, ne.def, or_true,
                 not_false_iff, neg_eq_zero, one_ne_zero] },
    { simp only [H₁, H₂, eq_self_iff_true, not_true, if_false,
                 ne.def, dir_inc_matrix_apply, or_self] } }
end

lemma incidence_set_orientation_head {e : G.edge_set} : e.val ∈ G.incidence_set (o.head e) :=
by { rw [incidence_equiv, o.consistent e], simp only [mem_iff, true_or, eq_self_iff_true] }

lemma incidence_set_orientation_tail {e : G.edge_set} : e.val ∈ G.incidence_set (o.tail e) :=
by { rw [incidence_equiv, o.consistent e], simp only [mem_iff, eq_self_iff_true, or_true] }

lemma incidence_set_orientation {i : V} {e : G.edge_set} :
  e.val ∈ G.incidence_set i ↔ i = o.head e ∨ i = o.tail e :=
begin
  rw o.consistent e,
  have key : ⟦(o.head e, o.tail e)⟧ ∈ G.edge_set, {rw ← o.consistent e, exact G.edge_val_in_set},
  exact G.incidence_set_iff_any_vertex key,
end

lemma not_incidence_set_orientation {i : V} {e : G.edge_set}
  (H_head : i ≠ o.head e) (H_tail : i ≠ o.tail e) : e.val ∉ G.incidence_set i :=
begin
  intro h,
  rw G.incidence_set_orientation at h,
  tauto,
end

-- 5. (N(o) i e) ^ 2 = M i e, for any orientation o, vertex i and edge e.
@[simp]
lemma dir_inc_matrix_elem_squared {i : V} {e : G.edge_set} :
  G.dir_inc_matrix R o i e * G.dir_inc_matrix R o i e = G.inc_matrix R i e :=
begin
  by_cases H_head : i = o.head e,
  { rw [G.dir_inc_matrix_head R H_head, H_head, mul_one, eq_comm, inc_matrix_one],
    exact G.incidence_set_orientation_head },
  { by_cases H_tail : i = o.tail e,
    { rw [G.dir_inc_matrix_tail R H_tail, H_tail, mul_neg_eq_neg_mul_symm, mul_one,
          neg_neg, eq_comm, inc_matrix_one],
      exact G.incidence_set_orientation_tail },
    { rw [(G.dir_inc_matrix_zero R).mpr ⟨H_head, H_tail⟩, mul_zero, eq_comm, inc_matrix_zero],
      exact G.not_incidence_set_orientation H_head H_tail } }
end

-- 6. For any adjacent vertices i j and edge e, N(o) i e * N(o) j e = if e = (i,j) then -1 else 0.
lemma dir_inc_matrix_prod_of_adj {i j : V} {e : G.edge_set} (H_adj : G.adj i j) :
  G.dir_inc_matrix R o i e * G.dir_inc_matrix R o j e = ite (e.val = ⟦(i, j)⟧) (-1) 0 :=
begin
  by_cases H_e : e.val = ⟦(i, j)⟧,
  { rw [H_e, if_pos rfl],
    rw [o.consistent e, eq_iff] at H_e,
    rcases H_e with (⟨H_head_i, H_tail_j⟩ | ⟨H_head_j, H_tail_i⟩),
    { rw [G.dir_inc_matrix_head R H_head_i.symm, G.dir_inc_matrix_tail R H_tail_j.symm,
          mul_neg_eq_neg_mul_symm, mul_one] },
    { rw [G.dir_inc_matrix_head R H_head_j.symm, G.dir_inc_matrix_tail R H_tail_i.symm, mul_one] } },
  { simp only [H_e, if_false],
    rw [o.consistent e, eq_iff, decidable.not_or_iff_and_not] at H_e,
    repeat { rw decidable.not_and_iff_or_not at H_e },
    rcases H_e with ⟨(H_head_i | H_tail_j), (H_head_j | H_tail_i)⟩,
    { have H_tail : o.tail e ≠ i ∨ o.tail e ≠ j,
      { by_contradiction h,
        rw [decidable.not_or_iff_and_not, not_not, not_not] at h,
        rcases h with ⟨h_i, h_j⟩, rw h_i at h_j,
        exact G.ne_of_adj H_adj h_j },
      cases H_tail with H_tail_i H_tail_j,
      { rw [(G.dir_inc_matrix_zero R).mpr ⟨ne.symm H_head_i, ne.symm H_tail_i⟩, zero_mul] },
      { rw [(G.dir_inc_matrix_zero R).mpr ⟨ne.symm H_head_j, ne.symm H_tail_j⟩, mul_zero] } },
    { rw [(G.dir_inc_matrix_zero R).mpr ⟨ne.symm H_head_i, ne.symm H_tail_i⟩, zero_mul] },
    { rw [(G.dir_inc_matrix_zero R).mpr ⟨ne.symm H_head_j, ne.symm H_tail_j⟩, mul_zero] },
    { have H_head : o.head e ≠ i ∨ o.head e ≠ j,
      { by_contradiction h,
        rw [decidable.not_or_iff_and_not, not_not, not_not] at h,
        rcases h with ⟨h_i, h_j⟩, rw h_i at h_j,
        exact G.ne_of_adj H_adj h_j },
      cases H_head with H_head_i H_head_j,
      { rw [(G.dir_inc_matrix_zero R).mpr ⟨ne.symm H_head_i, ne.symm H_tail_i⟩, zero_mul] },
      { rw [(G.dir_inc_matrix_zero R).mpr ⟨ne.symm H_head_j, ne.symm H_tail_j⟩, mul_zero] } } }
end

-- 7. For any non-adjacent distinct vertices i j and edge e, N(o) i e * N(o) j e = 0.
lemma dir_inc_matrix_prod_non_adj {i j : V} {e : G.edge_set} (H_ij : i ≠ j) (H_not_adj : ¬ G.adj i j) :
  G.dir_inc_matrix R o i e * G.dir_inc_matrix R o j e = 0 :=
begin
  by_cases H₁ : G.dir_inc_matrix R o i e = 0,
  { rw [H₁, zero_mul] },
  { by_cases H₂ : G.dir_inc_matrix R o j e = 0,
    { rw [H₂, mul_zero] },
    {
      rcases ((G.dir_inc_matrix_non_zero R).mp H₁) with (H_head_i | H_tail_i) ;
      rcases ((G.dir_inc_matrix_non_zero R).mp H₂) with (H_head_j | H_tail_j),
      { rw [H_head_i, H_head_j] at H_ij, tauto },
      { exfalso, apply H_not_adj, rw [H_head_i, H_tail_j, ← mem_edge_set, ← o.consistent e],
        simp only [subtype.coe_prop, subtype.val_eq_coe] },
      { exfalso, apply H_not_adj, rw [edge_symm, H_tail_i, H_head_j, ← mem_edge_set, ← o.consistent e],
        simp only [subtype.coe_prop, subtype.val_eq_coe] },
      { rw [H_tail_i, H_tail_j] at H_ij, tauto } } }
end

-- 8. (xᵀ ⬝ N) e = x head(e) - x tail(e).
lemma vec_mul_dir_inc_matrix {o : orientation G} (x : V → R) (e : G.edge_set) :
  vec_mul x (G.dir_inc_matrix R o) e = x (o.head e) - x (o.tail e) :=
begin
  simp only [vec_mul, dot_product, dir_inc_matrix, mul_ite, mul_one, mul_neg_eq_neg_mul_symm, mul_zero],
  rw [sum_ite, sum_ite, sum_filter, sum_ite_eq', sum_const_zero, add_zero, filter_filter],
  simp only [mem_univ, if_true],
  have key : filter (λ (a : V), ¬a = o.head e ∧ a = o.tail e) univ = {o.tail e},
  { ext,
    simp only [mem_filter, mem_singleton, true_and, and_iff_right_iff_imp, mem_univ],
    intro hyp,
    rw hyp,
    exact ne.symm (G.head_neq_tail) },
  rw [key, sum_singleton],
  ring_nf
end

end simple_graph


/-
Copyright (c) 2021 Yaël Dillies. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies, Eric Wieser
-/
import algebra.order.module
import data.real.basic

/-!
# Pointwise operations on sets of reals

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

This file relates `Inf (a • s)`/`Sup (a • s)` with `a • Inf s`/`a • Sup s` for `s : set ℝ`.

From these, it relates `⨅ i, a • f i` / `⨆ i, a • f i` with `a • (⨅ i, f i)` / `a • (⨆ i, f i)`,
and provides lemmas about distributing `*` over `⨅` and `⨆`.

# TODO

This is true more generally for conditionally complete linear order whose default value is `0`. We
don't have those yet.
-/

open set
open_locale pointwise

variables {ι : Sort*} {α : Type*} [linear_ordered_field α]

section mul_action_with_zero
variables [mul_action_with_zero α ℝ] [ordered_smul α ℝ] {a : α}

lemma real.Inf_smul_of_nonneg (ha : 0 ≤ a) (s : set ℝ) : Inf (a • s) = a • Inf s :=
begin
  obtain rfl | hs := s.eq_empty_or_nonempty,
  { rw [smul_set_empty, real.Inf_empty, smul_zero] },
  obtain rfl | ha' := ha.eq_or_lt,
  { rw [zero_smul_set hs, zero_smul],
    exact cInf_singleton 0 },
  by_cases bdd_below s,
  { exact ((order_iso.smul_left ℝ ha').map_cInf' hs h).symm },
  { rw [real.Inf_of_not_bdd_below (mt (bdd_below_smul_iff_of_pos ha').1 h),
      real.Inf_of_not_bdd_below h, smul_zero] }
end

lemma real.smul_infi_of_nonneg (ha : 0 ≤ a) (f : ι → ℝ) :
  a • (⨅ i, f i) = ⨅ i, a • f i :=
(real.Inf_smul_of_nonneg ha _).symm.trans $ congr_arg Inf $ (range_comp _ _).symm

lemma real.Sup_smul_of_nonneg (ha : 0 ≤ a) (s : set ℝ) : Sup (a • s) = a • Sup s :=
begin
  obtain rfl | hs := s.eq_empty_or_nonempty,
  { rw [smul_set_empty, real.Sup_empty, smul_zero] },
  obtain rfl | ha' := ha.eq_or_lt,
  { rw [zero_smul_set hs, zero_smul],
    exact cSup_singleton 0 },
  by_cases bdd_above s,
  { exact ((order_iso.smul_left ℝ ha').map_cSup' hs h).symm },
  { rw [real.Sup_of_not_bdd_above (mt (bdd_above_smul_iff_of_pos ha').1 h),
      real.Sup_of_not_bdd_above h, smul_zero] }
end

lemma real.smul_supr_of_nonneg (ha : 0 ≤ a) (f : ι → ℝ) :
  a • (⨆ i, f i) = ⨆ i, a • f i :=
(real.Sup_smul_of_nonneg ha _).symm.trans $ congr_arg Sup $ (range_comp _ _).symm

end mul_action_with_zero

section module
variables [module α ℝ] [ordered_smul α ℝ] {a : α}

lemma real.Inf_smul_of_nonpos (ha : a ≤ 0) (s : set ℝ) : Inf (a • s) = a • Sup s :=
begin
  obtain rfl | hs := s.eq_empty_or_nonempty,
  { rw [smul_set_empty, real.Inf_empty, real.Sup_empty, smul_zero] },
  obtain rfl | ha' := ha.eq_or_lt,
  { rw [zero_smul_set hs, zero_smul],
    exact cInf_singleton 0 },
  by_cases bdd_above s,
  { exact ((order_iso.smul_left_dual ℝ ha').map_cSup' hs h).symm },
  { rw [real.Inf_of_not_bdd_below (mt (bdd_below_smul_iff_of_neg ha').1 h),
      real.Sup_of_not_bdd_above h, smul_zero] }
end

lemma real.smul_supr_of_nonpos (ha : a ≤ 0) (f : ι → ℝ) :
  a • (⨆ i, f i) = ⨅ i, a • f i :=
(real.Inf_smul_of_nonpos ha _).symm.trans $ congr_arg Inf $ (range_comp _ _).symm

lemma real.Sup_smul_of_nonpos (ha : a ≤ 0) (s : set ℝ) : Sup (a • s) = a • Inf s :=
begin
  obtain rfl | hs := s.eq_empty_or_nonempty,
  { rw [smul_set_empty, real.Sup_empty, real.Inf_empty, smul_zero] },
  obtain rfl | ha' := ha.eq_or_lt,
  { rw [zero_smul_set hs, zero_smul],
    exact cSup_singleton 0 },
  by_cases bdd_below s,
  { exact ((order_iso.smul_left_dual ℝ ha').map_cInf' hs h).symm },
  { rw [real.Sup_of_not_bdd_above (mt (bdd_above_smul_iff_of_neg ha').1 h),
      real.Inf_of_not_bdd_below h, smul_zero] }
end

lemma real.smul_infi_of_nonpos (ha : a ≤ 0) (f : ι → ℝ) :
  a • (⨅ i, f i) = ⨆ i, a • f i :=
(real.Sup_smul_of_nonpos ha _).symm.trans $ congr_arg Sup $ (range_comp _ _).symm

end module

/-! ## Special cases for real multiplication -/

section mul

variables {r : ℝ}

lemma real.mul_infi_of_nonneg (ha : 0 ≤ r) (f : ι → ℝ) : r * (⨅ i, f i) = ⨅ i, r * f i :=
real.smul_infi_of_nonneg ha f

lemma real.mul_supr_of_nonneg (ha : 0 ≤ r) (f : ι → ℝ) : r * (⨆ i, f i) = ⨆ i, r * f i :=
real.smul_supr_of_nonneg ha f

lemma real.mul_infi_of_nonpos (ha : r ≤ 0) (f : ι → ℝ) : r * (⨅ i, f i) = ⨆ i, r * f i :=
real.smul_infi_of_nonpos ha f

lemma real.mul_supr_of_nonpos (ha : r ≤ 0) (f : ι → ℝ) : r * (⨆ i, f i) = ⨅ i, r * f i :=
real.smul_supr_of_nonpos ha f

lemma real.infi_mul_of_nonneg (ha : 0 ≤ r) (f : ι → ℝ) : (⨅ i, f i) * r = ⨅ i, f i * r :=
by simp only [real.mul_infi_of_nonneg ha, mul_comm]

lemma real.supr_mul_of_nonneg (ha : 0 ≤ r) (f : ι → ℝ) : (⨆ i, f i) * r = ⨆ i, f i * r :=
by simp only [real.mul_supr_of_nonneg ha, mul_comm]

lemma real.infi_mul_of_nonpos (ha : r ≤ 0) (f : ι → ℝ) : (⨅ i, f i) * r = ⨆ i, f i * r :=
by simp only [real.mul_infi_of_nonpos ha, mul_comm]

lemma real.supr_mul_of_nonpos (ha : r ≤ 0) (f : ι → ℝ) : (⨆ i, f i) * r = ⨅ i, f i * r :=
by simp only [real.mul_supr_of_nonpos ha, mul_comm]

end mul


/-
Copyright (c) 2021 Patrick Stevens. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Patrick Stevens, Thomas Browning

! This file was ported from Lean 3 source module data.nat.choose.central
! leanprover-community/mathlib commit 3e32bc908f617039c74c06ea9a897e30c30803c2
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Nat.Choose.Basic
import Mathbin.Tactic.Linarith.Default

/-!
# Central binomial coefficients

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

This file proves properties of the central binomial coefficients (that is, `nat.choose (2 * n) n`).

## Main definition and results

* `nat.central_binom`: the central binomial coefficient, `(2 * n).choose n`.
* `nat.succ_mul_central_binom_succ`: the inductive relationship between successive central binomial
  coefficients.
* `nat.four_pow_lt_mul_central_binom`: an exponential lower bound on the central binomial
  coefficient.
* `succ_dvd_central_binom`: The result that `n+1 ∣ n.central_binom`, ensuring that the explicit
  definition of the Catalan numbers is integer-valued.
-/

namespace Nat

#print Nat.centralBinom /-
/-- The central binomial coefficient, `nat.choose (2 * n) n`.
-/
def centralBinom (n : ℕ) :=
  (2 * n).choose n
#align nat.central_binom Nat.centralBinom
-/

#print Nat.centralBinom_eq_two_mul_choose /-
theorem centralBinom_eq_two_mul_choose (n : ℕ) : centralBinom n = (2 * n).choose n :=
  rfl
#align nat.central_binom_eq_two_mul_choose Nat.centralBinom_eq_two_mul_choose
-/

#print Nat.centralBinom_pos /-
theorem centralBinom_pos (n : ℕ) : 0 < centralBinom n :=
  choose_pos (Nat.le_mul_of_pos_left zero_lt_two)
#align nat.central_binom_pos Nat.centralBinom_pos
-/

#print Nat.centralBinom_ne_zero /-
theorem centralBinom_ne_zero (n : ℕ) : centralBinom n ≠ 0 :=
  (centralBinom_pos n).ne'
#align nat.central_binom_ne_zero Nat.centralBinom_ne_zero
-/

#print Nat.centralBinom_zero /-
@[simp]
theorem centralBinom_zero : centralBinom 0 = 1 :=
  choose_zero_right _
#align nat.central_binom_zero Nat.centralBinom_zero
-/

#print Nat.choose_le_centralBinom /-
/-- The central binomial coefficient is the largest binomial coefficient.
-/
theorem choose_le_centralBinom (r n : ℕ) : choose (2 * n) r ≤ centralBinom n :=
  calc
    (2 * n).choose r ≤ (2 * n).choose (2 * n / 2) := choose_le_middle r (2 * n)
    _ = (2 * n).choose n := by rw [Nat.mul_div_cancel_left n zero_lt_two]

#align nat.choose_le_central_binom Nat.choose_le_centralBinom
-/

#print Nat.two_le_centralBinom /-
theorem two_le_centralBinom (n : ℕ) (n_pos : 0 < n) : 2 ≤ centralBinom n :=
  calc
    2 ≤ 2 * n := le_mul_of_pos_right n_pos
    _ = (2 * n).choose 1 := (choose_one_right (2 * n)).symm
    _ ≤ centralBinom n := choose_le_centralBinom 1 n

#align nat.two_le_central_binom Nat.two_le_centralBinom
-/

#print Nat.succ_mul_centralBinom_succ /-
/-- An inductive property of the central binomial coefficient.
-/
theorem succ_mul_centralBinom_succ (n : ℕ) :
    (n + 1) * centralBinom (n + 1) = 2 * (2 * n + 1) * centralBinom n :=
  calc
    (n + 1) * (2 * (n + 1)).choose (n + 1) = (2 * n + 2).choose (n + 1) * (n + 1) := mul_comm _ _
    _ = (2 * n + 1).choose n * (2 * n + 2) := by rw [choose_succ_right_eq, choose_mul_succ_eq]
    _ = 2 * ((2 * n + 1).choose n * (n + 1)) := by ring
    _ = 2 * ((2 * n + 1).choose n * (2 * n + 1 - n)) := by
      rw [two_mul n, add_assoc, Nat.add_sub_cancel_left]
    _ = 2 * ((2 * n).choose n * (2 * n + 1)) := by rw [choose_mul_succ_eq]
    _ = 2 * (2 * n + 1) * (2 * n).choose n := by rw [mul_assoc, mul_comm (2 * n + 1)]

#align nat.succ_mul_central_binom_succ Nat.succ_mul_centralBinom_succ
-/

#print Nat.four_pow_lt_mul_centralBinom /-
/-- An exponential lower bound on the central binomial coefficient.
This bound is of interest because it appears in
[Tochiori's refinement of Erdős's proof of Bertrand's postulate](tochiori_bertrand).
-/
theorem four_pow_lt_mul_centralBinom (n : ℕ) (n_big : 4 ≤ n) : 4 ^ n < n * centralBinom n :=
  by
  induction' n using Nat.strong_induction_on with n IH
  rcases lt_trichotomy n 4 with (hn | rfl | hn)
  · clear IH
    decide!
  · norm_num [central_binom, choose]
  obtain ⟨n, rfl⟩ : ∃ m, n = m + 1 := Nat.exists_eq_succ_of_ne_zero (zero_lt_four.trans hn).ne'
  calc
    4 ^ (n + 1) < 4 * (n * central_binom n) :=
      (mul_lt_mul_left <| zero_lt_four' ℕ).mpr (IH n n.lt_succ_self (Nat.le_of_lt_succ hn))
    _ ≤ 2 * (2 * n + 1) * central_binom n :=
      by
      rw [← mul_assoc]
      linarith
    _ = (n + 1) * central_binom (n + 1) := (succ_mul_central_binom_succ n).symm

#align nat.four_pow_lt_mul_central_binom Nat.four_pow_lt_mul_centralBinom
-/

#print Nat.four_pow_le_two_mul_self_mul_centralBinom /-
/-- An exponential lower bound on the central binomial coefficient.
This bound is weaker than `nat.four_pow_lt_mul_central_binom`, but it is of historical interest
because it appears in Erdős's proof of Bertrand's postulate.
-/
theorem four_pow_le_two_mul_self_mul_centralBinom :
    ∀ (n : ℕ) (n_pos : 0 < n), 4 ^ n ≤ 2 * n * centralBinom n
  | 0, pr => (Nat.not_lt_zero _ pr).elim
  | 1, pr => by norm_num [central_binom, choose]
  | 2, pr => by norm_num [central_binom, choose]
  | 3, pr => by norm_num [central_binom, choose]
  | n@(m + 4), _ =>
    calc
      4 ^ n ≤ n * centralBinom n := (four_pow_lt_mul_centralBinom _ le_add_self).le
      _ ≤ 2 * n * centralBinom n := by
        rw [mul_assoc]
        refine' le_mul_of_pos_left zero_lt_two

#align nat.four_pow_le_two_mul_self_mul_central_binom Nat.four_pow_le_two_mul_self_mul_centralBinom
-/

#print Nat.two_dvd_centralBinom_succ /-
theorem two_dvd_centralBinom_succ (n : ℕ) : 2 ∣ centralBinom (n + 1) :=
  by
  use (n + 1 + n).choose n
  rw [central_binom_eq_two_mul_choose, two_mul, ← add_assoc, choose_succ_succ, choose_symm_add, ←
    two_mul]
#align nat.two_dvd_central_binom_succ Nat.two_dvd_centralBinom_succ
-/

#print Nat.two_dvd_centralBinom_of_one_le /-
theorem two_dvd_centralBinom_of_one_le {n : ℕ} (h : 0 < n) : 2 ∣ centralBinom n :=
  by
  rw [← Nat.succ_pred_eq_of_pos h]
  exact two_dvd_central_binom_succ n.pred
#align nat.two_dvd_central_binom_of_one_le Nat.two_dvd_centralBinom_of_one_le
-/

#print Nat.succ_dvd_centralBinom /-
/-- A crucial lemma to ensure that Catalan numbers can be defined via their explicit formula
  `catalan n = n.central_binom / (n + 1)`. -/
theorem succ_dvd_centralBinom (n : ℕ) : n + 1 ∣ n.centralBinom :=
  by
  have h_s : (n + 1).coprime (2 * n + 1) :=
    by
    rw [two_mul, add_assoc, coprime_add_self_right, coprime_self_add_left]
    exact coprime_one_left n
  apply h_s.dvd_of_dvd_mul_left
  apply dvd_of_mul_dvd_mul_left zero_lt_two
  rw [← mul_assoc, ← succ_mul_central_binom_succ, mul_comm]
  exact mul_dvd_mul_left _ (two_dvd_central_binom_succ n)
#align nat.succ_dvd_central_binom Nat.succ_dvd_centralBinom
-/

end Nat


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

! This file was ported from Lean 3 source module algebra.lie.character
! leanprover-community/mathlib commit 132328c4dd48da87adca5d408ca54f315282b719
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.Lie.Abelian
import Mathbin.Algebra.Lie.Solvable
import Mathbin.LinearAlgebra.Dual

/-!
# Characters of Lie algebras

A character of a Lie algebra `L` over a commutative ring `R` is a morphism of Lie algebras `L → R`,
where `R` is regarded as a Lie algebra over itself via the ring commutator. For an Abelian Lie
algebra (e.g., a Cartan subalgebra of a semisimple Lie algebra) a character is just a linear form.

## Main definitions

  * `lie_algebra.lie_character`
  * `lie_algebra.lie_character_equiv_linear_dual`

## Tags

lie algebra, lie character
-/

universe u v w w₁

namespace LieAlgebra

variable (R : Type u) (L : Type v) [CommRing R] [LieRing L] [LieAlgebra R L]

/-- A character of a Lie algebra is a morphism to the scalars. -/
abbrev LieCharacter :=
  L →ₗ⁅R⁆ R
#align lie_algebra.lie_character LieAlgebra.LieCharacter

variable {R L}

@[simp]
theorem lieCharacter_apply_lie (χ : LieCharacter R L) (x y : L) : χ ⁅x, y⁆ = 0 := by
  rw [LieHom.map_lie, LieRing.of_associative_ring_bracket, mul_comm, sub_self]
#align lie_algebra.lie_character_apply_lie LieAlgebra.lieCharacter_apply_lie

theorem lieCharacter_apply_of_mem_derived (χ : LieCharacter R L) {x : L}
    (h : x ∈ derivedSeries R L 1) : χ x = 0 :=
  by
  rw [derived_series_def, derived_series_of_ideal_succ, derived_series_of_ideal_zero, ←
    LieSubmodule.mem_coeSubmodule, LieSubmodule.lieIdeal_oper_eq_linear_span] at h
  apply Submodule.span_induction h
  · rintro y ⟨⟨z, hz⟩, ⟨⟨w, hw⟩, rfl⟩⟩
    apply lie_character_apply_lie
  · exact χ.map_zero
  · intro y z hy hz
    rw [LieHom.map_add, hy, hz, add_zero]
  · intro t y hy
    rw [LieHom.map_smul, hy, smul_zero]
#align lie_algebra.lie_character_apply_of_mem_derived LieAlgebra.lieCharacter_apply_of_mem_derived

/-- For an Abelian Lie algebra, characters are just linear forms. -/
@[simps]
def lieCharacterEquivLinearDual [IsLieAbelian L] : LieCharacter R L ≃ Module.Dual R L
    where
  toFun χ := (χ : L →ₗ[R] R)
  invFun ψ :=
    { ψ with
      map_lie' := fun x y => by
        rw [LieModule.IsTrivial.trivial, LieRing.of_associative_ring_bracket, mul_comm, sub_self,
          LinearMap.toFun_eq_coe, LinearMap.map_zero] }
  left_inv χ := by
    ext
    rfl
  right_inv ψ := by
    ext
    rfl
#align lie_algebra.lie_character_equiv_linear_dual LieAlgebra.lieCharacterEquivLinearDual

end LieAlgebra