-- we compute the cardinality of the vectors of length n.succ
-- whose product is 1

import sylow.prod_eq_one

namespace mygroup

variables (G : Type) [group G] (n : ℕ)

/-- Given a vector `v` of length `n`, make a vector of length `n+1` whose product is `1`,
by consing the the inverse of the product of `v`. -/
@[reducible] def finmap.to_succ (v : fin n → G) :
fin (n.succ) → G := λ i, if h : i.1 < n then v ⟨i.1, h⟩ else ((list.of_fn v).prod')⁻¹

def finmap.to_succ.prod_eq_one (v : fin n → G) :
  finmap.prod_eq_one (finmap.to_succ G n v) :=
begin
  unfold finmap.prod_eq_one,
  rw vector.to_list.succ',
  rw list.prod_append',
  rw list.prod_singleton',
  unfold finmap.to_succ,
  simp,
  convert group.mul_right_inv ((list.of_fn v).prod'),
  ext i,
  rw dif_pos i.2
end

lemma finmap.to_succ_injective (n : ℕ) :
  function.injective (finmap.to_succ G n) :=
λ v w h,
begin
  ext m,
  unfold finmap.to_succ at h,
  replace h := congr_fun h ⟨m.1, lt_trans m.2 (nat.lt_succ_self n)⟩,
  simp at h,
  rw dif_pos m.2 at h,
  rwa dif_pos m.2 at h,
end

lemma finmap.last_eq_inv_prod (v : fin n.succ → G) (hv : finmap.prod_eq_one v) :
v ⟨n, nat.lt_succ_self n⟩ = ((list.of_fn
  (λ i, v ⟨i.1, lt_trans i.2 (nat.lt_succ_self n)⟩ : fin n → G)).prod')⁻¹ :=
begin
  unfold finmap.prod_eq_one at hv,
  rw [vector.to_list.succ', list.prod_append', list.prod_singleton'] at hv,
  replace hv := group.eq_inv_mul_of_mul_eq hv,
  rw group.mul_one at hv,
  convert hv, simp,
  ext i,
  simp,
  congr'
end

def prod_eq_one_equiv : {v : fin n.succ → G // finmap.prod_eq_one v} ≃ (fin n → G) :=
{ to_fun := λ v i, v.1 ⟨i.1, lt_trans i.2 (nat.lt_succ_self n)⟩,
  inv_fun := λ v, ⟨finmap.to_succ G n v, finmap.to_succ.prod_eq_one G n v⟩,
  left_inv := λ v, begin
    cases v with v hv,
    ext i,
    simp,
    cases i with i his,
    unfold finmap.to_succ,
    by_cases hi : i < n,
    { rw dif_pos hi },
    rw dif_neg hi,
    rw nat.lt_succ_iff_lt_or_eq at his,
    cases his with his hin, contradiction,
    symmetry' at hin,
    subst hin,
    convert (finmap.last_eq_inv_prod G n v hv).symm
  end,
  right_inv := begin
    intro v,
    ext i,
    unfold finmap.prod_eq_one,
    unfold finmap.to_succ,
    simp,
    rw dif_pos i.2
  end
}

open_locale classical

noncomputable instance (X : Type) [fintype X] (Y : Type) [fintype Y] : fintype (X → Y) :=
by apply_instance

lemma card_function (X : Type) [fintype X] (Y : Type) [fintype Y] :
  fincard (X → Y) = fincard Y ^ fincard X :=
begin
  rw ← fincard.card_eq_fincard,
  rw ← fincard.card_eq_fincard,
  rw ← fincard.card_eq_fincard,
  convert fintype.card_fun,
end

noncomputable instance foo2 [fintype G] : fintype {v : fin n.succ → G // finmap.prod_eq_one v} :=
begin
  exact fintype.of_equiv (fin n → G) (prod_eq_one_equiv G n).symm
end

lemma card_cool_set [fintype G] :
  fincard {v : fin n.succ → G // finmap.prod_eq_one v} = fincard G ^ n :=
begin
  rw fincard.of_equiv (prod_eq_one_equiv G n),
  rw card_function,
  congr',
  rw ←fincard.card_eq_fincard,
  simp,
end

-- NEED TO COUNT.

-- todo : card (vector G n) = |G|^n

end mygroup


/-
Copyright (c) 2021 Ivan Sadofschi Costa. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Ivan Sadofschi Costa.
-/
import data.mv_polynomial.basic
import algebra.algebra.basic
import degree
import degree_new
import reduce_degree
import lemma_2_1
import data.mv_polynomial.comm_ring
import lemmas_g_S

/-!
# Combinatorial Nullstellensatz

In this file we prove the Combinatorial Nullstellensatz.
Our reference is
  N. Alon, Combinatorial Nullstellensatz, Combinatorics, Probability and Computing 8 (1999), 7-29.

## Main results

- `combinatorial_nullstellensatz`: Theorem 1.2 in Alon's paper.
- `combinatorial_nullstellensatz'`: Theorem 1.1 in Alon's paper.

-/

open_locale big_operators

namespace mv_polynomial

/- Theorem 1.1 in Alon's paper. -/
theorem combinatorial_nullstellensatz' {R σ : Type*} [comm_ring R] [is_domain R] [fintype σ]
 [decidable_eq σ] (f : mv_polynomial σ R) (S : σ → finset R) (hS : ∀ i : σ, 0 < (S i).card)
  (hz : ∀ s : σ → R, (∀ i : σ, s i ∈ S i ) → eval s f = 0) :
  ∃ h : σ → mv_polynomial σ R, (∀ i : σ, h i = 0 ∨ total_degree (h i) + (S i).card ≤ total_degree f)
    ∧ f = ∑ i : σ, h i * ∏ s in (S i), (X i - C s) :=
begin
  cases (reduce_degree_special_case S hS f) with h h_h,
  use h,
  split,
  { exact h_h.1 },
  { rw ← sub_eq_zero,
    apply lemma_2_1 _ S (λ j, h_h.2 j) _,
    intros s h_s,
    simp only [ring_hom.map_sub, hz s h_s, eval_sum, zero_sub, neg_eq_zero, ring_hom.map_mul],
    apply finset.sum_eq_zero,
    intros i hi,
    simp [eval_g_S_eq_zero (S i) (hS i) s i (h_s i)] },
end

theorem combinatorial_nullstellensatz'' {R σ : Type*} [comm_ring R] [is_domain R]
  [fintype σ] [decidable_eq σ] (f : mv_polynomial σ R) (t : σ →₀ ℕ)
  (h_max : max_degree_monomial t f) (S : σ → finset R) (h_card_S : ∀ i : σ, t i + 1 = (S i).card) :
  ∃ s : σ → R, (∀ i : σ, s i ∈ S i ) ∧ eval s f ≠ 0 :=
begin
  by_contra hc,
  cases combinatorial_nullstellensatz' f S (λ i , lt_of_le_of_lt (zero_le (t i)) (by simp [←h_card_S i]))
    (by simpa using hc) with h h1,
  clear hc,
  suffices h_zero : coeff t (∑ i : σ, h i * ∏ s in (S i), (X i - C s)) =  0,
  { simpa [h_zero, h1.2] using h_max.1 },
  simp only [coeff_sum],
  apply finset.sum_eq_zero,
  intros i hi,
  by_cases c1 : coeff t (h i * ∏ (s : R) in S i, (X i - C s)) = 0,
  { exact c1 },
  { by_cases c : monomial_degree t > total_degree (h i * ∏ (s : R) in S i, (X i - C s)),
    { exact coeff_zero_of_degree_greater_than_total_degree t _ c },
    { by_cases c'' : h i = 0,
      { simp [c''] },
      { simpa only [finsupp.single_eq_same, ←h_card_S, add_le_iff_nonpos_right, le_zero_iff] using
          dominant_monomial_of_factor_is_factor_of_max_degree_monomial (S i) t
            (finsupp.single i (S i).card) (h i) (∏ (s : R) in S i, (X i - C s))
            ⟨mem_support_iff.mpr c1, le_antisymm (not_lt.mp c) _⟩  c'' (dominant_monomial_g_S (S i) i) i,
        by_cases c' : h i = 0,
        { simp [c', zero_mul] },
        { rw [total_degree_mul' c' (g_S_ne_0 (S i) i), total_degree_g_S, h_max.2],
          by_cases hi0 : h i = 0,
          { simpa [hi0] using c1 },
          { exact or.resolve_left (h1.1 i) hi0 } } } } },
end

private lemma choose_smaller_sets {R σ : Type*} (S : σ → finset R) (t : σ →₀ ℕ)
  (h_card_S : ∀ i : σ, t i < (S i).card) : ∃ S' : σ → finset R,
    (∀ i : σ, S' i ⊆ S i) ∧ (∀ i : σ, (S' i).card = t i + 1) :=
begin
  have t := λ i, finset.exists_smaller_set (S i) (t i +1) (h_card_S i),
  convert classical.skolem.1 t,
  ext S',
  rw forall_and_distrib,
end

/-
  Theorem 1.2 in Alon's paper.
-/
theorem combinatorial_nullstellensatz {R σ : Type*} [comm_ring R] [is_domain R] [fintype σ]
 [decidable_eq σ] (f : mv_polynomial σ R) (t : σ →₀ ℕ) (h_max : max_degree_monomial t f)
  (S : σ → finset R) (h_card_S : ∀ i : σ, t i < (S i).card) : ∃ s : σ → R,
    (∀ i : σ, s i ∈ S i ) ∧ eval s f ≠ 0 :=
begin
  cases choose_smaller_sets S t h_card_S with S' hS',
  cases combinatorial_nullstellensatz'' f t h_max S' (λ i,  ((hS'.2) i).symm) with s h_s',
  exact ⟨ s, ⟨λ i, finset.mem_of_subset (hS'.1 i) (h_s'.1 i), h_s'.2 ⟩⟩,
end

end mv_polynomial


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

import data.mv_polynomial.variables
import data.mv_polynomial.derivation

/-!
# Partial derivatives of polynomials

This file defines the notion of the formal *partial derivative* of a polynomial,
the derivative with respect to a single variable.
This derivative is not connected to the notion of derivative from analysis.
It is based purely on the polynomial exponents and coefficients.

## Main declarations

* `mv_polynomial.pderiv i p` : the partial derivative of `p` with respect to `i`, as a bundled
  derivation of `mv_polynomial σ R`.

## Notation

As in other polynomial files, we typically use the notation:

+ `σ : Type*` (indexing the variables)

+ `R : Type*` `[comm_ring R]` (the coefficients)

+ `s : σ →₀ ℕ`, a function from `σ` to `ℕ` which is zero away from a finite set.
This will give rise to a monomial in `mv_polynomial σ R` which mathematicians might call `X^s`

+ `a : R`

+ `i : σ`, with corresponding monomial `X i`, often denoted `X_i` by mathematicians

+ `p : mv_polynomial σ R`

-/

noncomputable theory

universes u v

namespace mv_polynomial

open set function finsupp add_monoid_algebra
open_locale classical big_operators

variables {R : Type u} {σ : Type v} {a a' a₁ a₂ : R} {s : σ →₀ ℕ}

section pderiv

variables {R} [comm_semiring R]

/-- `pderiv i p` is the partial derivative of `p` with respect to `i` -/
def pderiv (i : σ) : derivation R (mv_polynomial σ R) (mv_polynomial σ R) :=
mk_derivation R $ pi.single i 1

@[simp] lemma pderiv_monomial {i : σ} :
  pderiv i (monomial s a) = monomial (s - single i 1) (a * (s i)) :=
begin
  simp only [pderiv, mk_derivation_monomial, finsupp.smul_sum, smul_eq_mul,
    ← smul_mul_assoc, ← (monomial _).map_smul],
  refine (finset.sum_eq_single i (λ j hj hne, _) (λ hi, _)).trans _,
  { simp [pi.single_eq_of_ne hne] },
  { rw [finsupp.not_mem_support_iff] at hi, simp [hi] },
  { simp }
end

lemma pderiv_C {i : σ} : pderiv i (C a) = 0 := derivation_C _ _

lemma pderiv_one {i : σ} : pderiv i (1 : mv_polynomial σ R) = 0 := pderiv_C

@[simp] lemma pderiv_X [d : decidable_eq σ] (i j : σ) :
  pderiv i (X j : mv_polynomial σ R) = @pi.single σ _ d _ i 1 j :=
(mk_derivation_X _ _ _).trans (by congr)

@[simp] lemma pderiv_X_self (i : σ) : pderiv i (X i : mv_polynomial σ R) = 1 := by simp

@[simp] lemma pderiv_X_of_ne {i j : σ} (h : j ≠ i) : pderiv i (X j : mv_polynomial σ R) = 0 :=
by simp [h]

lemma pderiv_eq_zero_of_not_mem_vars {i : σ} {f : mv_polynomial σ R} (h : i ∉ f.vars) :
  pderiv i f = 0 :=
derivation_eq_zero_of_forall_mem_vars $ λ j hj, pderiv_X_of_ne $ ne_of_mem_of_not_mem hj h

lemma pderiv_monomial_single {i : σ} {n : ℕ} :
  pderiv i (monomial (single i n) a) = monomial (single i (n-1)) (a * n) :=
by simp

lemma pderiv_mul {i : σ} {f g : mv_polynomial σ R} :
  pderiv i (f * g) = pderiv i f * g + f * pderiv i g :=
by simp only [(pderiv i).leibniz f g, smul_eq_mul, mul_comm, add_comm]

@[simp] lemma pderiv_C_mul {f : mv_polynomial σ R} {i : σ} :
  pderiv i (C a * f) = C a * pderiv i f :=
(derivation_C_mul _ _ _).trans C_mul'.symm

end pderiv

end mv_polynomial


/-
Copyright (c) 2020 Patrick Stevens. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Patrick Stevens, Bolton Bailey
-/
import data.nat.choose.factorization
import data.nat.prime_norm_num
import number_theory.primorial
import analysis.convex.specific_functions

/-!
# Bertrand's Postulate

This file contains a proof of Bertrand's postulate: That between any positive number and its
double there is a prime.

The proof follows the outline of the Erdős proof presented in "Proofs from THE BOOK": One considers
the prime factorization of `(2 * n).choose n`, and splits the constituent primes up into various
groups, then upper bounds the contribution of each group. This upper bounds the central binomial
coefficient, and if the postulate does not hold, this upper bound conflicts with a simple lower
bound for large enough `n`. This proves the result holds for large enough `n`, and for smaller `n`
an explicit list of primes is provided which covers the remaining cases.

As in the [Metamath implementation](carneiro2015arithmetic), we rely on some optimizations from
[Shigenori Tochiori](tochiori_bertrand). In particular we use the cleaner bound on the central
binomial coefficient given in `nat.four_pow_lt_mul_central_binom`.

## References

* [M. Aigner and G. M. Ziegler _Proofs from THE BOOK_][aigner1999proofs]
* [S. Tochiori, _Considering the Proof of “There is a Prime between n and 2n”_][tochiori_bertrand]
* [M. Carneiro, _Arithmetic in Metamath, Case Study: Bertrand's Postulate_][carneiro2015arithmetic]

## Tags

Bertrand, prime, binomial coefficients
-/

open_locale big_operators

section real

open real

namespace bertrand

/--
A reified version of the `bertrand.main_inequality` below.
This is not best possible: it actually holds for 464 ≤ x.
-/
lemma real_main_inequality {x : ℝ} (n_large : (512 : ℝ) ≤ x) :
  x * (2 * x) ^ (sqrt (2 * x)) * 4 ^ (2 * x / 3) ≤ 4 ^ x :=
begin
  let f : ℝ → ℝ := λ x, log x + sqrt (2 * x) * log (2 * x) - log 4 / 3 * x,
  have hf' : ∀ x, 0 < x → 0 < x * (2 * x) ^ sqrt (2 * x) / 4 ^ (x / 3) :=
  λ x h, div_pos (mul_pos h (rpow_pos_of_pos (mul_pos two_pos h) _)) (rpow_pos_of_pos four_pos _),
  have hf : ∀ x, 0 < x → f x = log (x * (2 * x) ^ sqrt (2 * x) / 4 ^ (x / 3)),
  { intros x h5,
    have h6 := mul_pos (zero_lt_two' ℝ) h5,
    have h7 := rpow_pos_of_pos h6 (sqrt (2 * x)),
    rw [log_div (mul_pos h5 h7).ne' (rpow_pos_of_pos four_pos _).ne', log_mul h5.ne' h7.ne',
      log_rpow h6, log_rpow zero_lt_four, ← mul_div_right_comm, ← mul_div, mul_comm x] },
  have h5 : 0 < x := lt_of_lt_of_le (by norm_num1) n_large,
  rw [← div_le_one (rpow_pos_of_pos four_pos x), ← div_div_eq_mul_div, ← rpow_sub four_pos,
      ← mul_div 2 x, mul_div_left_comm, ← mul_one_sub, (by norm_num1 : (1 : ℝ) - 2 / 3 = 1 / 3),
      mul_one_div, ← log_nonpos_iff (hf' x h5), ← hf x h5],
  have h : concave_on ℝ (set.Ioi 0.5) f,
  { refine ((strict_concave_on_log_Ioi.concave_on.subset (set.Ioi_subset_Ioi _)
      (convex_Ioi 0.5)).add ((strict_concave_on_sqrt_mul_log_Ioi.concave_on.comp_linear_map
      ((2 : ℝ) • linear_map.id)).subset
      (λ a ha, lt_of_eq_of_lt _ ((mul_lt_mul_left two_pos).mpr ha)) (convex_Ioi 0.5))).sub
      ((convex_on_id (convex_Ioi (0.5 : ℝ))).smul (div_nonneg (log_nonneg _) _)); norm_num1 },
  suffices : ∃ x1 x2, 0.5 < x1 ∧ x1 < x2 ∧ x2 ≤ x ∧ 0 ≤ f x1 ∧ f x2 ≤ 0,
  { obtain ⟨x1, x2, h1, h2, h0, h3, h4⟩ := this,
    exact (h.right_le_of_le_left'' h1 ((h1.trans h2).trans_le h0) h2 h0 (h4.trans h3)).trans h4 },
  refine ⟨18, 512, by norm_num1, by norm_num1, le_trans (by norm_num1) n_large, _, _⟩,
  { have : sqrt (2 * 18) = 6 :=
    (sqrt_eq_iff_mul_self_eq_of_pos (by norm_num1)).mpr (by norm_num1),
    rw [hf, log_nonneg_iff (hf' 18 _), this]; norm_num1 },
  { have : sqrt (2 * 512) = 32,
    { exact (sqrt_eq_iff_mul_self_eq_of_pos (by norm_num1)).mpr (by norm_num1) },
    rw [hf, log_nonpos_iff (hf' _ _), this, div_le_one (rpow_pos_of_pos four_pos _),
      ← rpow_le_rpow_iff _ (rpow_pos_of_pos four_pos _).le three_pos, ← rpow_mul]; norm_num1 },
end

end bertrand

end real

section nat

open nat

/--
The inequality which contradicts Bertrand's postulate, for large enough `n`.
-/
lemma bertrand_main_inequality {n : ℕ} (n_large : 512 ≤ n) :
  n * (2 * n) ^ sqrt (2 * n) * 4 ^ (2 * n / 3) ≤ 4 ^ n :=
begin
  rw ← @cast_le ℝ,
  simp only [cast_bit0, cast_add, cast_one, cast_mul, cast_pow, ← real.rpow_nat_cast],
  have n_pos : 0 < n := (dec_trivial : 0 < 512).trans_le n_large,
  have n2_pos : 1 ≤ 2 * n := mul_pos dec_trivial n_pos,
  refine trans (mul_le_mul _ _ _ _) (bertrand.real_main_inequality (by exact_mod_cast n_large)),
  { refine mul_le_mul_of_nonneg_left _ (nat.cast_nonneg _),
    refine real.rpow_le_rpow_of_exponent_le (by exact_mod_cast n2_pos) _,
    exact_mod_cast real.nat_sqrt_le_real_sqrt },
  { exact real.rpow_le_rpow_of_exponent_le (by norm_num1) (cast_div_le.trans (by norm_cast)) },
  { exact real.rpow_nonneg_of_nonneg (by norm_num1) _ },
  { refine mul_nonneg (nat.cast_nonneg _) _,
    exact real.rpow_nonneg_of_nonneg (mul_nonneg zero_le_two (nat.cast_nonneg _)) _, },
end

/--
A lemma that tells us that, in the case where Bertrand's postulate does not hold, the prime
factorization of the central binomial coefficent only has factors at most `2 * n / 3 + 1`.
-/
lemma central_binom_factorization_small (n : ℕ) (n_large : 2 < n)
  (no_prime: ¬∃ (p : ℕ), p.prime ∧ n < p ∧ p ≤ 2 * n) :
  central_binom n = ∏ p in finset.range (2 * n / 3 + 1), p ^ ((central_binom n).factorization p) :=
begin
  refine (eq.trans _ n.prod_pow_factorization_central_binom).symm,
  apply finset.prod_subset,
  { exact finset.range_subset.2 (add_le_add_right (nat.div_le_self _ _) _) },
  intros x hx h2x,
  rw [finset.mem_range, lt_succ_iff] at hx h2x,
  rw [not_le, div_lt_iff_lt_mul' three_pos, mul_comm x] at h2x,
  replace no_prime := not_exists.mp no_prime x,
  rw [←and_assoc, not_and', not_and_distrib, not_lt] at no_prime,
  cases no_prime hx with h h,
  { rw [factorization_eq_zero_of_non_prime n.central_binom h, pow_zero] },
  { rw [factorization_central_binom_of_two_mul_self_lt_three_mul n_large h h2x, pow_zero] },
end

/--
An upper bound on the central binomial coefficient used in the proof of Bertrand's postulate.
The bound splits the prime factors of `central_binom n` into those
1. At most `sqrt (2 * n)`, which contribute at most `2 * n` for each such prime.
2. Between `sqrt (2 * n)` and `2 * n / 3`, which contribute at most `4^(2 * n / 3)` in total.
3. Between `2 * n / 3` and `n`, which do not exist.
4. Between `n` and `2 * n`, which would not exist in the case where Bertrand's postulate is false.
5. Above `2 * n`, which do not exist.
-/
lemma central_binom_le_of_no_bertrand_prime (n : ℕ) (n_big : 2 < n)
  (no_prime : ¬∃ (p : ℕ), nat.prime p ∧ n < p ∧ p ≤ 2 * n) :
  central_binom n ≤ (2 * n) ^ sqrt (2 * n) * 4 ^ (2 * n / 3) :=
begin
  have n_pos : 0 < n := (nat.zero_le _).trans_lt n_big,
  have n2_pos : 1 ≤ 2 * n := mul_pos (zero_lt_two' ℕ) n_pos,
  let S := (finset.range (2 * n / 3 + 1)).filter nat.prime,
  let f := λ x, x ^ n.central_binom.factorization x,
  have : ∏ (x : ℕ) in S, f x = ∏ (x : ℕ) in finset.range (2 * n / 3 + 1), f x,
  { refine finset.prod_filter_of_ne (λ p hp h, _),
    contrapose! h, dsimp only [f],
    rw [factorization_eq_zero_of_non_prime n.central_binom h, pow_zero] },
  rw [central_binom_factorization_small n n_big no_prime, ← this,
    ← finset.prod_filter_mul_prod_filter_not S (≤ sqrt (2 * n))],
  apply mul_le_mul',
  { refine (finset.prod_le_prod' (λ p hp, (_ : f p ≤ 2 * n))).trans _,
    { exact pow_factorization_choose_le (mul_pos two_pos n_pos) },
    have : (finset.Icc 1 (sqrt (2 * n))).card = sqrt (2 * n),
    { rw [card_Icc, nat.add_sub_cancel] },
    rw finset.prod_const,
    refine pow_le_pow n2_pos ((finset.card_le_of_subset (λ x hx, _)).trans this.le),
    obtain ⟨h1, h2⟩ := finset.mem_filter.1 hx,
    exact finset.mem_Icc.mpr ⟨(finset.mem_filter.1 h1).2.one_lt.le, h2⟩ },
  { refine le_trans _ (primorial_le_4_pow (2 * n / 3)),
    refine (finset.prod_le_prod' (λ p hp, (_ : f p ≤ p))).trans _,
    { obtain ⟨h1, h2⟩ := finset.mem_filter.1 hp,
      refine (pow_le_pow (finset.mem_filter.1 h1).2.one_lt.le _).trans (pow_one p).le,
      exact nat.factorization_choose_le_one (sqrt_lt'.mp $ not_le.1 h2) },
    refine finset.prod_le_prod_of_subset_of_one_le' (finset.filter_subset _ _) _,
    exact λ p hp _, (finset.mem_filter.1 hp).2.one_lt.le }
end

namespace nat

/--
Proves that Bertrand's postulate holds for all sufficiently large `n`.
-/
lemma exists_prime_lt_and_le_two_mul_eventually (n : ℕ) (n_big : 512 ≤ n) :
  ∃ (p : ℕ), p.prime ∧ n < p ∧ p ≤ 2 * n :=
begin
  -- Assume there is no prime in the range.
  by_contradiction no_prime,
  -- Then we have the above sub-exponential bound on the size of this central binomial coefficient.
  -- We now couple this bound with an exponential lower bound on the central binomial coefficient,
  -- yielding an inequality which we have seen is false for large enough n.
  have H1 : n * (2 * n) ^ sqrt (2 * n) * 4 ^ (2 * n / 3) ≤ 4 ^ n := bertrand_main_inequality n_big,
  have H2 : 4 ^ n < n * n.central_binom :=
    nat.four_pow_lt_mul_central_binom n (le_trans (by norm_num1) n_big),
  have H3 : n.central_binom ≤ (2 * n) ^ sqrt (2 * n) * 4 ^ (2 * n / 3) :=
    central_binom_le_of_no_bertrand_prime n (lt_of_lt_of_le (by norm_num1) n_big) no_prime,
  rw mul_assoc at H1, exact not_le.2 H2 ((mul_le_mul_left' H3 n).trans H1),
end

/--
Proves that Bertrand's postulate holds over all positive naturals less than n by identifying a
descending list of primes, each no more than twice the next, such that the list contains a witness
for each number ≤ n.
-/
lemma exists_prime_lt_and_le_two_mul_succ {n} (q)
  {p : ℕ} (prime_p : nat.prime p) (covering : p ≤ 2 * q)
  (H : n < q → ∃ (p : ℕ), p.prime ∧ n < p ∧ p ≤ 2 * n)
  (hn : n < p) : ∃ (p : ℕ), p.prime ∧ n < p ∧ p ≤ 2 * n :=
begin
  by_cases p ≤ 2 * n, { exact ⟨p, prime_p, hn, h⟩ },
  exact H (lt_of_mul_lt_mul_left' (lt_of_lt_of_le (not_le.1 h) covering))
end

/--
**Bertrand's Postulate**: For any positive natural number, there is a prime which is greater than
it, but no more than twice as large.
-/
theorem exists_prime_lt_and_le_two_mul (n : ℕ) (hn0 : n ≠ 0) :
  ∃ p, nat.prime p ∧ n < p ∧ p ≤ 2 * n :=
begin
  -- Split into cases whether `n` is large or small
  cases lt_or_le 511 n,
  -- If `n` is large, apply the lemma derived from the inequalities on the central binomial
  -- coefficient.
  { exact exists_prime_lt_and_le_two_mul_eventually n h, },
  replace h : n < 521 := h.trans_lt (by norm_num1),
  revert h,
  -- For small `n`, supply a list of primes to cover the initial cases.
  ([317, 163, 83, 43, 23, 13, 7, 5, 3, 2].mmap' $ λ n,
    `[refine exists_prime_lt_and_le_two_mul_succ %%(reflect n) (by norm_num1) (by norm_num1) _]),
  exact λ h2, ⟨2, prime_two, h2, nat.mul_le_mul_left 2 (nat.pos_of_ne_zero hn0)⟩,
end

alias nat.exists_prime_lt_and_le_two_mul ← bertrand

end nat

end nat


import Duck.Math.CategoryTheory.Category

namespace Math.CategoryTheory

variable {C : Type} [Category C] {X Y Z : C} {f : X ⟶ Y} {g : Y ⟶ Z}

theorem mono_id : (𝟙 X).mono := by {
  intro _ _ _;
  rw [Category.id_comp, Category.id_comp];
  intro t;
  exact t;
}

theorem epi_id : (𝟙 X).epi := by {
  intro _ _ _;
  rw [Category.comp_id, Category.comp_id];
  intro t;
  exact t;
}

theorem mono_comp (h₁ : f.mono) (h₂ : g.mono) : (g ≫ f).mono := by {
  intro _ _ _ a;
  rw [Category.comp_assoc, Category.comp_assoc] at a;
  exact h₁ (h₂ a);
}

theorem epi_comp (h₁ : f.epi) (h₂ : g.epi) : (g ≫ f).epi := by {
  intro _ _ _ a;
  rw [← Category.comp_assoc, ← Category.comp_assoc] at a;
  exact h₂ (h₁ a);
}

theorem mono_of_mono (h : (g ≫ f).mono) : f.mono := by {
  intro _ _ _ a;
  exact h (by rw [Category.comp_assoc, Category.comp_assoc, a]);
}

theorem epi_of_epi (h : (g ≫ f).epi) : g.epi := by {
  intro _ _ _ a;
  exact h (by rw [← Category.comp_assoc, ← Category.comp_assoc, a]);
}

theorem initial_iso (h₁ : initial X) (h₂ : initial Y) : ∃ (f : X ⟶ Y), f.isomorphism := by {
  match (h₁ Y) with
  | Exists.intro f hf => {
    apply Exists.intro f;
    match (h₂ X) with
    | Exists.intro g hg => {
      apply Exists.intro g;
      apply And.intro;
      match (h₁ X) with
      | Exists.intro i hi => rw [← hi (g ≫ f), hi (𝟙 X)];
      match (h₂ Y) with
      | Exists.intro i hi => rw [← hi (f ≫ g), hi (𝟙 Y)];
    }
  }
}

theorem final_iso (h₁ : final X) (h₂ : final Y) : ∃ (f : X ⟶ Y), f.isomorphism := by {
  match (h₂ X) with
  | Exists.intro f hf => {
    apply Exists.intro f;
    match (h₁ Y) with
    | Exists.intro g hg => {
      apply Exists.intro g;
      apply And.intro;
      match (h₁ X) with
      | Exists.intro i hi => rw [← hi (g ≫ f), hi (𝟙 X)];
      match (h₂ Y) with
      | Exists.intro i hi => rw [← hi (f ≫ g), hi (𝟙 Y)];
    }
  }
}

end Math.CategoryTheory


/-
Copyright (c) 2020 The Xena project. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kevin Buzzard.
Thanks: Imperial College London, leanprover-community
-/

-- Import everything about the real numbers
import data.real.basic

/-!
# The complex numbers

We define the complex numbers, and prove that they are a ring.

We also "extract some basic API" (e.g. we prove that
two complex numbers are equal iff they have the same
real and imaginary parts)

This file has no `sorry`s in. All of the other levels:

`Level_01_of_real.lean`
`Level_02_I.lean`
`Level_03_conj.lean`
`Level_04_norm_sq.lean`
`Level_05_field.lean`
`Level_06_alg_closed.lean`

have sorrys, indicating puzzles to be solved.

# Main Definitions

`zero` : the complex number 0
`one` : the complex number 1
`add` -- addition of two complex numbers
`neg` -- negation of a complex number
`mul` -- multiplication of two complex numbers

# Main Theorem

`comm_ring` : The complex numbers are a commutative ring.

-/

/-- A complex number is defined to be a structure consisting of two real
  numbers, the real part and the imaginary part of the complex numberd. -/
structure complex : Type :=
(re : ℝ) (im : ℝ)

-- Let's use the usual notation for the complex numbers
notation `ℂ` := complex

-- You make the complex number with real part 3 and imaginary part 4 like this:
example : ℂ :=
{ re := 3,
  im := 4 }

-- Or like this:
example : ℂ := complex.mk 3 4

-- or like this:
example : ℂ := ⟨3, 4⟩

-- They all give the same complex number.

example : complex.mk 3 4 = ⟨3, 4⟩ := begin refl end  -- "true by definition"

-- All of our definitions, like `zero` and `one`, will all
-- live in the `complex` namespace.

namespace complex

-- If you have a complex number, then you can get its real and
-- imaginary parts with the `re` and `im` functions.

example : ℝ := re(mk 3 4) -- this term is (3 : ℝ)

example : re(mk 3 4) = 3 := begin refl end

-- Computer scientists prefer the style `z.re` to `re(z)` for some reason.

example : (mk 3 4).re = 3 := begin refl end

example (z : ℂ) : re(z) = z.re := begin refl end

-- Before we start making the basic
-- We now prove the basic theorems and make the basic definitions for
-- complex numbers. For example, we will define addition and multiplication on
-- the complex numbers, and prove that it is a commutative ring.
-- TODO fix

/-! # Defining the ring structure on ℂ -/

-- Our main goal is to prove that the complexes are a ring. Let's
-- define the structure first; the zero, one, addition and multiplication
-- on the complexes.

/-! ## zero (0) -/

/-- The complex number with real part 0 and imaginary part 0 -/
def zero : ℂ := sorry

-- Now we set up notation so that `0 : ℂ` will mean `zero`.

/-- notation `0` for `zero` -/
instance : has_zero ℂ := ⟨zero⟩

-- Let's prove the two basic properties, both of which are true by definition,
-- and then tag them with the appropriate attributes.
@[simp] lemma zero_re : re(0 : ℂ) = 0 := sorry
@[simp] lemma zero_im : im(0 : ℂ) = 0 := sorry

/-! ## one (1) -/

-- Now let's do the same thing for 1.

/-- The complex number with real part 1 and imaginary part 0 -/
def one : ℂ := sorry

/-- Notation `1` for `one` -/
instance : has_one ℂ := ⟨one⟩

-- name the basic properties and tag them with `simp`
@[simp] lemma one_re : re(1 : ℂ) = 1 := sorry
@[simp] lemma one_im : im(1 : ℂ) = 0 := sorry

/-! ## add (+) -/

-- Now let's define addition

/-- addition `z+w` of complex numbers -/
def add (z w : ℂ) : ℂ := sorry

/-- Notation `+` for addition -/
instance : has_add ℂ := ⟨add⟩

-- basic properties
@[simp] lemma add_re (z w : ℂ) : re(z + w) = re(z) + re(w) := sorry
@[simp] lemma add_im (z w : ℂ) : im(z + w) = im(z) + im(w) := sorry

/-! ## neg (-) -/

-- negation

/-- The negation `-z` of a complex number `z` -/
def neg (z : ℂ) : ℂ := sorry

/-- Notation `-` for negation -/
instance : has_neg ℂ := ⟨neg⟩

-- how neg interacts with re and im
@[simp] lemma neg_re (z : ℂ) : re(-z) = -re(z) := sorry
@[simp] lemma neg_im (z : ℂ) : im(-z) = -im(z) := sorry

/-! ## mul (*) -/

-- multiplication

/-- Multiplication `z*w` of two complex numbers -/
def mul (z w : ℂ) : ℂ := sorry

/-- Notation `*` for multiplication -/
instance : has_mul ℂ := ⟨mul⟩

-- how `mul` reacts with `re` and `im`
@[simp] lemma mul_re (z w : ℂ) : re(z * w) = re(z) * re(w) - im(z) * im(w) :=
sorry

@[simp] lemma mul_im (z w : ℂ) : im(z * w) = re(z) * im(w) + im(z) * re(w) :=
sorry

/-! ## Example of what `simp` can now do

example (a b c : ℂ) :
  re(a*(b+c)) = re(a) * (re(b) + re(c)) - im(a) * (im(b) + im(c)) :=
begin
  simp,
end

-/

/-! # `ext` : A mathematical triviality -/

/-
Two complex numbers with the same and imaginary parts are equal. This is an
"extensionality lemma", i.e. a lemma of the form "if two things are made from
the same pieces, they are equal". This is not hard to prove, but we want to
give the result a name so we can tag it with the `ext` attribute, meaning that
the `ext` tactic will know it. To add to the confusion, let's call the
theorem `ext` :-)
-/

/-- If two complex numbers z and w have equal real and imaginary parts,
    they are equal -/
@[ext] theorem ext {z w : ℂ}
  (hre : re(z) = re(w)) (him : im(z) = im(w)) : z = w :=
begin
  sorry
end

/-! # Theorem:  The complex numbers are a commutative ring

Proof: we've defined all the structure, and every axiom can be checked by
reducing it to checking real and imaginary parts with `ext`, expanding
everything out with `simp`, and then using the fact that the real numbers are
a commutative ring (which we already know)

-/

/-- The complex numbers are a commutative ring -/
instance : comm_ring ℂ :=
begin
  -- first the data
  refine_struct {
      zero := (0 : ℂ), add := (+), neg := has_neg.neg, one := 1, mul := (*),
  ..},
  sorry,
  sorry,
  sorry,
  sorry,
  sorry,
  sorry,
  sorry,
  sorry,
  sorry,
  sorry,
  sorry,
end

/-

That is the end of the proof that the complexes form a ring. We built
a basic API which was honed towards the general idea that to prove
certain statements about the complex numbers, for example distributivity,
we could just check on real and imaginary parts. We trained the
simplifier to expand out things like re(z*w) in terms
of re(z), im(z), re(w), im(w).

-/

/-!

# Optional (for mathematicians) : more basic infrastructure, and term mode

-/

/-!
## `ext` revisited

Recall extensionality:

theorem ext {z w : ℂ}
  (hre : re(z) = re(w)) (him : im(z) = im(w)) : z = w := ...

Here is another tactic mode proof of extensionality. Note that we have moved
the hypotheses to the other side of the colon; this does not
change the theorem. This proof shows the power
of the `rintros` tactic.
-/

theorem ext' : ∀ z w : ℂ, z.re = w.re → z.im = w.im → z = w :=
begin
  rintros ⟨zr, zi⟩ ⟨_, _⟩ ⟨rfl⟩ ⟨rfl⟩,
  refl,
end

/-!

Explanation: `rintros` does `cases` as many times as you like using this cool
`⟨ ⟩` syntax for the case splits. Note that if you say that a proof of `a = b`
is `rfl` then Lean will define a to be b, or b to be a, and not even introduce
new notation for it.

-/

-- Here is the same proof in term mode.

theorem ext'' : ∀ {z w : ℂ}, z.re = w.re → z.im = w.im → z = w
| ⟨zr, zi⟩ ⟨_, _⟩ rfl rfl := rfl

/-!
## `eta`
-/

/-
We prove the mathematically obvious statement that the
complex number whose real part is re(z) and whose imaginary
part is im(z) is of course equal to z.
-/

/-- ⟨z.re, z.im⟩ is equal to z -/
@[simp] theorem eta : ∀ z : ℂ, complex.mk z.re z.im = z :=
begin
  intro z,
  cases z with x y,
  /-
    goal now looks complicated, and contains terms which look
    like {re := a, im := b}.re which obviously simplify to a.
    The `dsimp` tactic will do some tidying up for us, although
    it is not logically necessary. `dsimp` does definitional simplification.
  -/
  dsimp,
  -- Now we see the goal can be solved by reflexivity
  refl,
end

/-
The proof was "unfold everything, and it's true by definition".
This proof does not teach a mathematician anything, so we may as well write
it in term mode. Many tactics have term mode equivalent.
The equation compiler does the `intro` and `cases` steps,
and `dsimp` was unnecessary -- the two sides of the equation
were definitionally equal.
-/

theorem eta' : ∀ z : ℂ, complex.mk z.re z.im = z
| ⟨x, y⟩ := rfl

/-!
## ext_iff
-/

/-
Note that `ext` is an implication -- if re(z)=re(w) and im(z)=im(w) then z=w.
The below variant `ext_iff` is the two-way implication: two complex
numbers are equal if and only if they have the same real and imaginary part.
Let's first see a tactic mode proof. See how the `ext` tactic is used?
After it is applied, we have two goals, both of which are hypotheses.
The semicolon means "apply the next tactic to all the goals
produced by this one"
-/

theorem ext_iff {z w : ℂ} : z = w ↔ z.re = w.re ∧ z.im = w.im :=
begin
  split,
  { intro H,
    simp [H]},
  {
    rintro ⟨hre, him⟩,
    ext; assumption,
  }
end

-- Again this is easy to write in term mode, and no mathematician
-- wants to read the proof anyway.

theorem ext_iff' {z w : ℂ} : z = w ↔ z.re = w.re ∧ z.im = w.im :=
⟨λ H, by simp [H], and.rec ext⟩

end complex

/-!

# some last comments on the `simp` tactic

Some equalities, even if obvious, had to be given names, because we want `simp`
to be able to use them. In short, the `simp` tactic tries to solve
goals of the form A = B, when `refl` doesn't work (i.e. the goals are
not definitionally equal) but when any mathematician would be able
to simplify A and B via "obvious" steps such as `0 + x = x` or
`⟨z.re, z.im⟩ = z`. These things are sometimes not true by definition,
but they should be tagged as being well-known ways to simplify an equality.
When building our API for the complex numbers, if we prove a theorem of the
form `A = B` where `B` is a bit simpler than `A`, we should probably
tag it with the `@[simp]` attribute, so `simp` can use it.

Note: `simp` does *not* prove "all simple things". It proves *equalities*.
It proves `A = B` when, and only when, it can do it by applying
its "simplification rules", where a simplification rule is simply a proof
of a theorem of the form `A = B` and `B` is simpler than `A`.
-/


/-
Copyright (c) 2018 Robert Y. Lewis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Robert Y. Lewis
-/
import algebra.order.absolute_value
import algebra.field_power
import ring_theory.int.basic
import tactic.basic
import tactic.ring_exp
import number_theory.divisors
import data.nat.factorization.basic

/-!
# p-adic Valuation

This file defines the p-adic valuation on ℕ, ℤ, and ℚ.

The p-adic valuation on ℚ is the difference of the multiplicities of `p` in the numerator and
denominator of `q`. This function obeys the standard properties of a valuation, with the appropriate
assumptions on p. The p-adic valuations on ℕ and ℤ agree with that on ℚ.

The valuation induces a norm on ℚ. This norm is defined in padic_norm.lean.

## Notations

This file uses the local notation `/.` for `rat.mk`.

## Implementation notes

Much, but not all, of this file assumes that `p` is prime. This assumption is inferred automatically
by taking `[fact (prime p)]` as a type class argument.

## References

* [F. Q. Gouvêa, *p-adic numbers*][gouvea1997]
* [R. Y. Lewis, *A formal proof of Hensel's lemma over the p-adic integers*][lewis2019]
* <https://en.wikipedia.org/wiki/P-adic_number>

## Tags

p-adic, p adic, padic, norm, valuation
-/

universe u

open nat

open_locale rat

open multiplicity

/--
For `p ≠ 1`, the p-adic valuation of a natural `n ≠ 0` is the largest natural number `k` such that
p^k divides z.
If `n = 0` or `p = 1`, then `padic_val_nat p q` defaults to 0.
-/
def padic_val_nat (p : ℕ) (n : ℕ) : ℕ :=
if h : p ≠ 1 ∧ 0 < n
then (multiplicity p n).get (multiplicity.finite_nat_iff.2 h)
else 0

namespace padic_val_nat
open multiplicity
variables {p : ℕ}

/-- `padic_val_nat p 0` is 0 for any `p`. -/
@[simp] protected lemma zero : padic_val_nat p 0 = 0 :=
by simp [padic_val_nat]

/-- `padic_val_nat p 1` is 0 for any `p`. -/
@[simp] protected lemma one : padic_val_nat p 1 = 0 :=
by unfold padic_val_nat; split_ifs; simp *

/-- For `p ≠ 0, p ≠ 1, `padic_val_rat p p` is 1. -/
@[simp] lemma self (hp : 1 < p) : padic_val_nat p p = 1 :=
begin
  have neq_one : (¬ p = 1) ↔ true,
  { exact iff_of_true ((ne_of_lt hp).symm) trivial, },
  have eq_zero_false : (p = 0) ↔ false,
  { exact iff_false_intro ((ne_of_lt (trans zero_lt_one hp)).symm) },
  simp [padic_val_nat, neq_one, eq_zero_false],
end

lemma eq_zero_of_not_dvd {n : ℕ} (h : ¬ p ∣ n) : padic_val_nat p n = 0 :=
begin
  rw padic_val_nat,
  split_ifs,
  { simp [multiplicity_eq_zero_of_not_dvd h], },
  refl,
end

end padic_val_nat

/--
For `p ≠ 1`, the p-adic valuation of an integer `z ≠ 0` is the largest natural number `k` such that
p^k divides z.
If `x = 0` or `p = 1`, then `padic_val_int p q` defaults to 0.
-/
def padic_val_int (p : ℕ) (z : ℤ) : ℕ :=
padic_val_nat p (z.nat_abs)

namespace padic_val_int
open multiplicity
variables {p : ℕ}

lemma of_ne_one_ne_zero {z : ℤ} (hp : p ≠ 1) (hz : z ≠ 0) : padic_val_int p z =
  (multiplicity (p : ℤ) z).get (by {apply multiplicity.finite_int_iff.2, simp [hp, hz]}) :=
begin
  rw [padic_val_int, padic_val_nat, dif_pos (and.intro hp (int.nat_abs_pos_of_ne_zero hz))],
  simp_rw multiplicity.int.nat_abs p z,
  refl,
end

/-- `padic_val_int p 0` is 0 for any `p`. -/
@[simp] protected lemma zero : padic_val_int p 0 = 0 :=
by simp [padic_val_int]

/-- `padic_val_int p 1` is 0 for any `p`. -/
@[simp] protected lemma one : padic_val_int p 1 = 0 :=
by simp [padic_val_int]

/-- The p-adic value of an natural is its p-adic_value as an integer -/
@[simp] lemma of_nat {n : ℕ} : padic_val_int p (n : ℤ) = padic_val_nat p n :=
by simp [padic_val_int]

/-- For `p ≠ 0, p ≠ 1, `padic_val_int p p` is 1. -/
lemma self (hp : 1 < p) : padic_val_int p p = 1 :=
by simp [padic_val_nat.self hp]

lemma eq_zero_of_not_dvd {z : ℤ} (h : ¬ (p : ℤ) ∣ z) : padic_val_int p z = 0 :=
begin
  rw [padic_val_int, padic_val_nat],
  split_ifs,
  { simp_rw multiplicity.int.nat_abs,
    simp [multiplicity_eq_zero_of_not_dvd h], },
  refl,
end

end padic_val_int

/--
`padic_val_rat` defines the valuation of a rational `q` to be the valuation of `q.num` minus the
valuation of `q.denom`.
If `q = 0` or `p = 1`, then `padic_val_rat p q` defaults to 0.
-/
def padic_val_rat (p : ℕ) (q : ℚ) : ℤ :=
padic_val_int p q.num - padic_val_nat p q.denom

namespace padic_val_rat
open multiplicity
variables {p : ℕ}

/-- `padic_val_rat p q` is symmetric in `q`. -/
@[simp] protected lemma neg (q : ℚ) : padic_val_rat p (-q) = padic_val_rat p q :=
by simp [padic_val_rat, padic_val_int]

/-- `padic_val_rat p 0` is 0 for any `p`. -/
@[simp]
protected lemma zero (m : nat) : padic_val_rat m 0 = 0 := by simp [padic_val_rat, padic_val_int]

/-- `padic_val_rat p 1` is 0 for any `p`. -/
@[simp] protected lemma one : padic_val_rat p 1 = 0 := by simp [padic_val_rat, padic_val_int]

/-- The p-adic value of an integer `z ≠ 0` is its p-adic_value as a rational -/
@[simp] lemma of_int {z : ℤ} : padic_val_rat p (z : ℚ) = padic_val_int p z :=
by simp [padic_val_rat]

/-- The p-adic value of an integer `z ≠ 0` is the multiplicity of `p` in `z`. -/
lemma of_int_multiplicity (z : ℤ) (hp : p ≠ 1) (hz : z ≠ 0) :
  padic_val_rat p (z : ℚ) = (multiplicity (p : ℤ) z).get
    (finite_int_iff.2 ⟨hp, hz⟩) :=
by rw [of_int, padic_val_int.of_ne_one_ne_zero hp hz]

lemma multiplicity_sub_multiplicity {q : ℚ} (hp : p ≠ 1) (hq : q ≠ 0) :
  padic_val_rat p q =
  (multiplicity (p : ℤ) q.num).get (finite_int_iff.2 ⟨hp, rat.num_ne_zero_of_ne_zero hq⟩) -
  (multiplicity p q.denom).get
    (by { rw [←finite_iff_dom, finite_nat_iff, and_iff_right hp], exact q.pos }) :=
begin
  rw [padic_val_rat, padic_val_int.of_ne_one_ne_zero hp, padic_val_nat, dif_pos],
  { refl },
  { exact ⟨hp, q.pos⟩ },
  { exact rat.num_ne_zero_of_ne_zero hq },
end

/-- The p-adic value of an integer `z ≠ 0` is its p-adic_value as a rational -/
@[simp] lemma of_nat {n : ℕ} : padic_val_rat p (n : ℚ) = padic_val_nat p n :=
by simp [padic_val_rat, padic_val_int]

/-- For `p ≠ 0, p ≠ 1, `padic_val_rat p p` is 1. -/
lemma self (hp : 1 < p) : padic_val_rat p p = 1 := by simp [of_nat, hp]

end padic_val_rat

section padic_val_nat

lemma zero_le_padic_val_rat_of_nat (p n : ℕ) : 0 ≤ padic_val_rat p n := by simp

-- /-- `padic_val_rat` coincides with `padic_val_nat`. -/
@[norm_cast] lemma padic_val_rat_of_nat (p n : ℕ) :
  ↑(padic_val_nat p n) = padic_val_rat p n :=
by simp [padic_val_rat, padic_val_int]

/--
A simplification of `padic_val_nat` when one input is prime, by analogy with `padic_val_rat_def`.
-/
lemma padic_val_nat_def {p : ℕ} [hp : fact p.prime] {n : ℕ} (hn : 0 < n) :
  padic_val_nat p n =
  (multiplicity p n).get
    (multiplicity.finite_nat_iff.2 ⟨nat.prime.ne_one hp.1, hn⟩) :=
begin
  simp [padic_val_nat],
  split_ifs,
  { refl, },
  { exfalso,
    apply h ⟨(hp.out).ne_one, hn⟩, }
end

lemma padic_val_nat_def' {n p : ℕ} (hp : p ≠ 1) (hn : 0 < n) :
  ↑(padic_val_nat p n) = multiplicity p n :=
by simp [padic_val_nat, hp, hn]

@[simp] lemma padic_val_nat_self (p : ℕ) [fact p.prime] : padic_val_nat p p = 1 :=
by simp [padic_val_nat_def (fact.out p.prime).pos]

lemma one_le_padic_val_nat_of_dvd
  {n p : nat} [prime : fact p.prime] (n_pos : 0 < n) (div : p ∣ n) :
  1 ≤ padic_val_nat p n :=
begin
  rw @padic_val_nat_def _ prime _ n_pos,
  let one_le_mul : _ ≤ multiplicity p n :=
    @multiplicity.le_multiplicity_of_pow_dvd _ _ _ p n 1 (begin norm_num, exact div end),
  simp only [nat.cast_one] at one_le_mul,
  rcases one_le_mul with ⟨_, q⟩,
  dsimp at q,
  solve_by_elim,
end

end padic_val_nat

namespace padic_val_rat
open multiplicity
variables (p : ℕ) [p_prime : fact p.prime]
include p_prime

/-- The multiplicity of `p : ℕ` in `a : ℤ` is finite exactly when `a ≠ 0`. -/
lemma finite_int_prime_iff {p : ℕ} [p_prime : fact p.prime] {a : ℤ} : finite (p : ℤ) a ↔ a ≠ 0 :=
by simp [finite_int_iff, ne.symm (ne_of_lt (p_prime.1.one_lt))]

/-- A rewrite lemma for `padic_val_rat p q` when `q` is expressed in terms of `rat.mk`. -/
protected lemma defn {q : ℚ} {n d : ℤ} (hqz : q ≠ 0) (qdf : q = n /. d) :
  padic_val_rat p q = (multiplicity (p : ℤ) n).get (finite_int_iff.2
    ⟨ne.symm $ ne_of_lt p_prime.1.one_lt, λ hn, by simp * at *⟩) -
  (multiplicity (p : ℤ) d).get (finite_int_iff.2 ⟨ne.symm $ ne_of_lt p_prime.1.one_lt,
    λ hd, by simp * at *⟩) :=
have hd : d ≠ 0, from rat.mk_denom_ne_zero_of_ne_zero hqz qdf,
let ⟨c, hc1, hc2⟩ := rat.num_denom_mk hd qdf in
begin
  rw [padic_val_rat.multiplicity_sub_multiplicity];
  simp [hc1, hc2, multiplicity.mul' (nat.prime_iff_prime_int.1 p_prime.1),
    (ne.symm (ne_of_lt p_prime.1.one_lt)), hqz, pos_iff_ne_zero],
  simp_rw [int.coe_nat_multiplicity p q.denom],
end

/-- A rewrite lemma for `padic_val_rat p (q * r)` with conditions `q ≠ 0`, `r ≠ 0`. -/
protected lemma mul {q r : ℚ} (hq : q ≠ 0) (hr : r ≠ 0) :
  padic_val_rat p (q * r) = padic_val_rat p q + padic_val_rat p r :=
have q*r = (q.num * r.num) /. (↑q.denom * ↑r.denom), by rw_mod_cast rat.mul_num_denom,
have hq' : q.num /. q.denom ≠ 0, by rw rat.num_denom; exact hq,
have hr' : r.num /. r.denom ≠ 0, by rw rat.num_denom; exact hr,
have hp' : _root_.prime (p : ℤ), from nat.prime_iff_prime_int.1 p_prime.1,
begin
  rw [padic_val_rat.defn p (mul_ne_zero hq hr) this],
  conv_rhs { rw [←(@rat.num_denom q), padic_val_rat.defn p hq',
    ←(@rat.num_denom r), padic_val_rat.defn p hr'] },
  rw [multiplicity.mul' hp', multiplicity.mul' hp']; simp [add_comm, add_left_comm, sub_eq_add_neg]
end

/-- A rewrite lemma for `padic_val_rat p (q^k)` with condition `q ≠ 0`. -/
protected lemma pow {q : ℚ} (hq : q ≠ 0) {k : ℕ} :
    padic_val_rat p (q ^ k) = k * padic_val_rat p q :=
by induction k; simp [*, padic_val_rat.mul _ hq (pow_ne_zero _ hq),
  pow_succ, add_mul, add_comm]

/--
A rewrite lemma for `padic_val_rat p (q⁻¹)` with condition `q ≠ 0`.
-/
protected lemma inv (q : ℚ) :
  padic_val_rat p (q⁻¹) = -padic_val_rat p q :=
begin
  by_cases hq : q = 0,
  { simp [hq], },
  { rw [eq_neg_iff_add_eq_zero, ← padic_val_rat.mul p (inv_ne_zero hq) hq,
      inv_mul_cancel hq, padic_val_rat.one] },
end

/-- A rewrite lemma for `padic_val_rat p (q / r)` with conditions `q ≠ 0`, `r ≠ 0`. -/
protected lemma div {q r : ℚ} (hq : q ≠ 0) (hr : r ≠ 0) :
  padic_val_rat p (q / r) = padic_val_rat p q - padic_val_rat p r :=
by rw [div_eq_mul_inv, padic_val_rat.mul p hq (inv_ne_zero hr),
    padic_val_rat.inv p r, sub_eq_add_neg]

/--
A condition for `padic_val_rat p (n₁ / d₁) ≤ padic_val_rat p (n₂ / d₂),
in terms of divisibility by `p^n`.
-/
lemma padic_val_rat_le_padic_val_rat_iff {n₁ n₂ d₁ d₂ : ℤ}
  (hn₁ : n₁ ≠ 0) (hn₂ : n₂ ≠ 0) (hd₁ : d₁ ≠ 0) (hd₂ : d₂ ≠ 0) :
  padic_val_rat p (n₁ /. d₁) ≤ padic_val_rat p (n₂ /. d₂) ↔
  ∀ (n : ℕ), ↑p ^ n ∣ n₁ * d₂ → ↑p ^ n ∣ n₂ * d₁ :=
have hf1 : finite (p : ℤ) (n₁ * d₂),
  from finite_int_prime_iff.2 (mul_ne_zero hn₁ hd₂),
have hf2 : finite (p : ℤ) (n₂ * d₁),
  from finite_int_prime_iff.2 (mul_ne_zero hn₂ hd₁),
  by conv
  { to_lhs,
    rw [padic_val_rat.defn p (rat.mk_ne_zero_of_ne_zero hn₁ hd₁) rfl,
      padic_val_rat.defn p (rat.mk_ne_zero_of_ne_zero hn₂ hd₂) rfl,
      sub_le_iff_le_add',
      ← add_sub_assoc,
      le_sub_iff_add_le],
    norm_cast,
    rw [← multiplicity.mul' (nat.prime_iff_prime_int.1 p_prime.1) hf1, add_comm,
      ← multiplicity.mul' (nat.prime_iff_prime_int.1 p_prime.1) hf2,
      enat.get_le_get, multiplicity_le_multiplicity_iff] }

/--
Sufficient conditions to show that the p-adic valuation of `q` is less than or equal to the
p-adic vlauation of `q + r`.
-/
theorem le_padic_val_rat_add_of_le {q r : ℚ}
  (hqr : q + r ≠ 0)
  (h : padic_val_rat p q ≤ padic_val_rat p r) :
  padic_val_rat p q ≤ padic_val_rat p (q + r) :=
if hq : q = 0 then by simpa [hq] using h else
if hr : r = 0 then by simp [hr] else
have hqn : q.num ≠ 0, from rat.num_ne_zero_of_ne_zero hq,
have hqd : (q.denom : ℤ) ≠ 0, by exact_mod_cast rat.denom_ne_zero _,
have hrn : r.num ≠ 0, from rat.num_ne_zero_of_ne_zero hr,
have hrd : (r.denom : ℤ) ≠ 0, by exact_mod_cast rat.denom_ne_zero _,
have hqreq : q + r = (((q.num * r.denom + q.denom * r.num : ℤ)) /. (↑q.denom * ↑r.denom : ℤ)),
  from rat.add_num_denom _ _,
have hqrd : q.num * ↑(r.denom) + ↑(q.denom) * r.num ≠ 0,
  from rat.mk_num_ne_zero_of_ne_zero hqr hqreq,
begin
  conv_lhs { rw ←(@rat.num_denom q) },
  rw [hqreq, padic_val_rat_le_padic_val_rat_iff p hqn hqrd hqd (mul_ne_zero hqd hrd),
    ← multiplicity_le_multiplicity_iff, mul_left_comm,
    multiplicity.mul (nat.prime_iff_prime_int.1 p_prime.1), add_mul],
  rw [←(@rat.num_denom q), ←(@rat.num_denom r),
    padic_val_rat_le_padic_val_rat_iff p hqn hrn hqd hrd, ← multiplicity_le_multiplicity_iff] at h,
  calc _ ≤ min (multiplicity ↑p (q.num * ↑(r.denom) * ↑(q.denom)))
    (multiplicity ↑p (↑(q.denom) * r.num * ↑(q.denom))) : (le_min
    (by rw [@multiplicity.mul _ _ _ _ (_ * _) _ (nat.prime_iff_prime_int.1 p_prime.1), add_comm])
    (by rw [mul_assoc, @multiplicity.mul _ _ _ _ (q.denom : ℤ)
        (_ * _) (nat.prime_iff_prime_int.1 p_prime.1)];
      exact add_le_add_left h _))
    ... ≤ _ : min_le_multiplicity_add
end

/--
The minimum of the valuations of `q` and `r` is less than or equal to the valuation of `q + r`.
-/
theorem min_le_padic_val_rat_add {q r : ℚ} (hqr : q + r ≠ 0) :
  min (padic_val_rat p q) (padic_val_rat p r) ≤ padic_val_rat p (q + r) :=
(le_total (padic_val_rat p q) (padic_val_rat p r)).elim
  (λ h, by rw [min_eq_left h]; exact le_padic_val_rat_add_of_le _ hqr h)
  (λ h, by rw [min_eq_right h, add_comm]; exact le_padic_val_rat_add_of_le _
    (by rwa add_comm) h)

open_locale big_operators

/-- A finite sum of rationals with positive p-adic valuation has positive p-adic valuation
  (if the sum is non-zero). -/
theorem sum_pos_of_pos {n : ℕ} {F : ℕ → ℚ}
  (hF : ∀ i, i < n → 0 < padic_val_rat p (F i)) (hn0 : ∑ i in finset.range n, F i ≠ 0) :
  0 < padic_val_rat p (∑ i in finset.range n, F i) :=
begin
  induction n with d hd,
  { exact false.elim (hn0 rfl) },
  { rw finset.sum_range_succ at hn0 ⊢,
    by_cases h : ∑ (x : ℕ) in finset.range d, F x = 0,
    { rw [h, zero_add],
      exact hF d (lt_add_one _) },
    { refine lt_of_lt_of_le _ (min_le_padic_val_rat_add p hn0),
      { refine lt_min (hd (λ i hi, _) h) (hF d (lt_add_one _)),
        exact hF _ (lt_trans hi (lt_add_one _)) }, } }
end

end padic_val_rat

namespace padic_val_nat

/-- A rewrite lemma for `padic_val_nat p (q * r)` with conditions `q ≠ 0`, `r ≠ 0`. -/
protected lemma mul (p : ℕ) [p_prime : fact p.prime] {q r : ℕ} (hq : q ≠ 0) (hr : r ≠ 0) :
  padic_val_nat p (q * r) = padic_val_nat p q + padic_val_nat p r :=
begin
  apply int.coe_nat_inj,
  simp only [padic_val_rat_of_nat, nat.cast_mul],
  rw padic_val_rat.mul,
  norm_cast,
  exact cast_ne_zero.mpr hq,
  exact cast_ne_zero.mpr hr,
end

protected lemma div_of_dvd (p : ℕ) [hp : fact p.prime] {a b : ℕ} (h : b ∣ a) :
  padic_val_nat p (a / b) = padic_val_nat p a - padic_val_nat p b :=
begin
  rcases eq_or_ne a 0 with rfl | ha,
  { simp },
  obtain ⟨k, rfl⟩ := h,
  obtain ⟨hb, hk⟩ := mul_ne_zero_iff.mp ha,
  rw [mul_comm, k.mul_div_cancel hb.bot_lt, padic_val_nat.mul p hk hb, nat.add_sub_cancel]
end

/-- Dividing out by a prime factor reduces the padic_val_nat by 1. -/
protected lemma div {p : ℕ} [p_prime : fact p.prime] {b : ℕ} (dvd : p ∣ b) :
  (padic_val_nat p (b / p)) = (padic_val_nat p b) - 1 :=
begin
  convert padic_val_nat.div_of_dvd p dvd,
  rw padic_val_nat_self p
end

/-- A version of `padic_val_rat.pow` for `padic_val_nat` -/
protected lemma pow (p q n : ℕ) [fact p.prime] (hq : q ≠ 0) :
  padic_val_nat p (q ^ n) = n * padic_val_nat p q :=
begin
  apply @nat.cast_injective ℤ,
  push_cast,
  exact padic_val_rat.pow _ (cast_ne_zero.mpr hq),
end

@[simp] protected lemma prime_pow (p n : ℕ) [fact p.prime] : padic_val_nat p (p ^ n) = n :=
by rw [padic_val_nat.pow p _ _ (fact.out p.prime).ne_zero, padic_val_nat_self p, mul_one]

protected lemma div_pow {p : ℕ} [p_prime : fact p.prime] {b k : ℕ} (dvd : p ^ k ∣ b) :
  (padic_val_nat p (b / p ^ k)) = (padic_val_nat p b) - k :=
begin
  convert padic_val_nat.div_of_dvd p dvd,
  rw padic_val_nat.prime_pow
end

end padic_val_nat

section padic_val_nat

lemma dvd_of_one_le_padic_val_nat {n p : nat} (hp : 1 ≤ padic_val_nat p n) :
  p ∣ n :=
begin
  by_contra h,
  rw padic_val_nat.eq_zero_of_not_dvd h at hp,
  exact lt_irrefl 0 (lt_of_lt_of_le zero_lt_one hp),
end

lemma pow_padic_val_nat_dvd {p n : ℕ} : p ^ (padic_val_nat p n) ∣ n :=
begin
  rcases n.eq_zero_or_pos with rfl | hn, { simp },
  rcases eq_or_ne p 1 with rfl | hp, { simp },
  rw [multiplicity.pow_dvd_iff_le_multiplicity, padic_val_nat_def']; assumption,
end

lemma pow_succ_padic_val_nat_not_dvd {p n : ℕ} [hp : fact (nat.prime p)] (hn : 0 < n) :
  ¬ p ^ (padic_val_nat p n + 1) ∣ n :=
begin
  rw multiplicity.pow_dvd_iff_le_multiplicity,
  rw padic_val_nat_def hn,
  { rw [nat.cast_add, enat.coe_get],
    simp only [nat.cast_one, not_le],
    exact enat.lt_add_one (ne_top_iff_finite.mpr
      (finite_nat_iff.mpr ⟨(fact.elim hp).ne_one, hn⟩)), },
  { apply_instance }
end

lemma padic_val_nat_dvd_iff (p : ℕ) [hp :fact p.prime] (n : ℕ) (a : ℕ) :
  p^n ∣ a ↔ a = 0 ∨ n ≤ padic_val_nat p a :=
begin
  split,
  { rw [pow_dvd_iff_le_multiplicity, padic_val_nat],
    split_ifs,
    { rw enat.coe_le_iff,
      exact λ hn, or.inr (hn _) },
    { simp only [true_and, not_lt, ne.def, not_false_iff, nat.le_zero_iff, hp.out.ne_one] at h,
      exact λ hn, or.inl h } },
  { rintro (rfl|h),
    { exact dvd_zero (p ^ n) },
    { exact dvd_trans (pow_dvd_pow p h) pow_padic_val_nat_dvd } },
end

lemma padic_val_nat_primes {p q : ℕ} [p_prime : fact p.prime] [q_prime : fact q.prime]
  (neq : p ≠ q) : padic_val_nat p q = 0 :=
@padic_val_nat.eq_zero_of_not_dvd p q $
(not_congr (iff.symm (prime_dvd_prime_iff_eq p_prime.1 q_prime.1))).mp neq

protected lemma padic_val_nat.div' {p : ℕ} [p_prime : fact p.prime] :
  ∀ {m : ℕ} (cpm : coprime p m) {b : ℕ} (dvd : m ∣ b), padic_val_nat p (b / m) = padic_val_nat p b
| 0 := λ cpm b dvd, by { rw zero_dvd_iff at dvd, rw [dvd, nat.zero_div], }
| (n + 1) :=
  λ cpm b dvd,
  begin
    rcases dvd with ⟨c, rfl⟩,
    rw [mul_div_right c (nat.succ_pos _)],by_cases hc : c = 0,
    { rw [hc, mul_zero] },
    { rw padic_val_nat.mul,
      { suffices : ¬ p ∣ (n+1),
        { rw [padic_val_nat.eq_zero_of_not_dvd this, zero_add] },
        contrapose! cpm,
        exact p_prime.1.dvd_iff_not_coprime.mp cpm },
      { exact nat.succ_ne_zero _ },
      { exact hc } },
  end

lemma padic_val_nat_eq_factorization (p n : ℕ) [hp : fact p.prime] :
  padic_val_nat p n = n.factorization p :=
begin
  by_cases hn : n = 0, { subst hn, simp },
  rw @padic_val_nat_def p _ n (nat.pos_of_ne_zero hn),
  simp [@multiplicity_eq_factorization n p hp.elim hn],
end

open_locale big_operators

lemma prod_pow_prime_padic_val_nat (n : nat) (hn : n ≠ 0) (m : nat) (pr : n < m) :
  ∏ p in finset.filter nat.prime (finset.range m), p ^ (padic_val_nat p n) = n :=
begin
  nth_rewrite_rhs 0 ←factorization_prod_pow_eq_self hn,
  rw eq_comm,
  apply finset.prod_subset_one_on_sdiff,
  { exact λ p hp, finset.mem_filter.mpr
      ⟨finset.mem_range.mpr (gt_of_gt_of_ge pr (le_of_mem_factorization hp)),
       prime_of_mem_factorization hp⟩ },
  { intros p hp,
    cases finset.mem_sdiff.mp hp with hp1 hp2,
    haveI := fact_iff.mpr (finset.mem_filter.mp hp1).2,
    rw padic_val_nat_eq_factorization p n,
    simp [finsupp.not_mem_support_iff.mp hp2] },
  { intros p hp,
    haveI := fact_iff.mpr (prime_of_mem_factorization hp),
    simp [padic_val_nat_eq_factorization] }
end

lemma range_pow_padic_val_nat_subset_divisors {n : ℕ} (p : ℕ) (hn : n ≠ 0) :
  (finset.range (padic_val_nat p n + 1)).image (pow p) ⊆ n.divisors :=
begin
  intros t ht,
  simp only [exists_prop, finset.mem_image, finset.mem_range] at ht,
  obtain ⟨k, hk, rfl⟩ := ht,
  rw nat.mem_divisors,
  exact ⟨(pow_dvd_pow p $ by linarith).trans pow_padic_val_nat_dvd, hn⟩
end

lemma range_pow_padic_val_nat_subset_divisors' {n : ℕ} (p : ℕ) [h : fact p.prime] :
  (finset.range (padic_val_nat p n)).image (λ t, p ^ (t + 1)) ⊆ (n.divisors \ {1}) :=
begin
  rcases eq_or_ne n 0 with rfl | hn,
  { simp },
  intros t ht,
  simp only [exists_prop, finset.mem_image, finset.mem_range] at ht,
  obtain ⟨k, hk, rfl⟩ := ht,
  rw [finset.mem_sdiff, nat.mem_divisors],
  refine ⟨⟨(pow_dvd_pow p $ by linarith).trans pow_padic_val_nat_dvd, hn⟩, _⟩,
  rw [finset.mem_singleton],
  nth_rewrite 1 ←one_pow (k + 1),
  exact (nat.pow_lt_pow_of_lt_left h.1.one_lt $ nat.succ_pos k).ne',
end

end padic_val_nat

section padic_val_int
variables (p : ℕ) [p_prime : fact p.prime]

lemma padic_val_int_dvd_iff (p : ℕ) [fact p.prime] (n : ℕ) (a : ℤ) :
  ↑p^n ∣ a ↔ a = 0 ∨ n ≤ padic_val_int p a :=
by rw [padic_val_int, ←int.nat_abs_eq_zero, ←padic_val_nat_dvd_iff, ←int.coe_nat_dvd_left,
       int.coe_nat_pow]

lemma padic_val_int_dvd (p : ℕ) [fact p.prime] (a : ℤ) : ↑p^(padic_val_int p a) ∣ a :=
begin
  rw padic_val_int_dvd_iff,
  exact or.inr le_rfl,
end

lemma padic_val_int_self (p : ℕ) [pp : fact p.prime] : padic_val_int p p = 1 :=
padic_val_int.self pp.out.one_lt

lemma padic_val_int.mul (p : ℕ) [fact p.prime] {a b : ℤ} (ha : a ≠ 0) (hb : b ≠ 0) :
  padic_val_int p (a*b) = padic_val_int p a + padic_val_int p b :=
begin
  simp_rw padic_val_int,
  rw [int.nat_abs_mul, padic_val_nat.mul];
  rwa int.nat_abs_ne_zero,
end

lemma padic_val_int_mul_eq_succ (p : ℕ) [pp : fact p.prime] (a : ℤ) (ha : a ≠ 0) :
  padic_val_int p (a * p) = (padic_val_int p a) + 1 :=
begin
  rw padic_val_int.mul p ha (int.coe_nat_ne_zero.mpr (pp.out).ne_zero),
  simp only [eq_self_iff_true, padic_val_int.of_nat, padic_val_nat_self],
end

end padic_val_int


/-
Copyright (c) 2014 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors Jeremy Avigad, Leonardo de Moura, Johannes Hölzl, Mario Carneiro

-- QUESTION: can make the first argument in ∀ x ∈ a, ... implicit?
-/
import logic.basic data.set.basic data.equiv.basic tactic
import order.complete_boolean_algebra category.basic
import tactic.finish data.sigma.basic order.galois_connection

open function tactic set lattice auto

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

namespace set

instance lattice_set : complete_lattice (set α) :=
{ lattice.complete_lattice .
  le           := (⊆),
  le_refl      := subset.refl,
  le_trans     := assume a b c, subset.trans,
  le_antisymm  := assume a b, subset.antisymm,

  lt           := λ x y, x ⊆ y ∧ ¬ y ⊆ x,
  lt_iff_le_not_le := λ x y, iff.refl _,

  sup          := (∪),
  le_sup_left  := subset_union_left,
  le_sup_right := subset_union_right,
  sup_le       := assume a b c, union_subset,

  inf          := (∩),
  inf_le_left  := inter_subset_left,
  inf_le_right := inter_subset_right,
  le_inf       := assume a b c, subset_inter,

  top          := {a | true },
  le_top       := assume s a h, trivial,

  bot          := ∅,
  bot_le       := assume s a, false.elim,

  Sup          := λs, {a | ∃ t ∈ s, a ∈ t },
  le_Sup       := assume s t t_in a a_in, ⟨t, ⟨t_in, a_in⟩⟩,
  Sup_le       := assume s t h a ⟨t', ⟨t'_in, a_in⟩⟩, h t' t'_in a_in,

  Inf          := λs, {a | ∀ t ∈ s, a ∈ t },
  le_Inf       := assume s t h a a_in t' t'_in, h t' t'_in a_in,
  Inf_le       := assume s t t_in a h, h _ t_in }

instance : distrib_lattice (set α) :=
{ le_sup_inf := λ s t u x, or_and_distrib_left.2, ..set.lattice_set }

lemma monotone_image {f : α → β} : monotone (image f) :=
assume s t, assume h : s ⊆ t, image_subset _ h

section galois_connection
variables {f : α → β}

protected lemma image_preimage : galois_connection (image f) (preimage f) :=
assume a b, image_subset_iff

def kern_image (f : α → β) (s : set α) : set β := {y | ∀x, f x = y → x ∈ s}

protected lemma preimage_kern_image : galois_connection (preimage f) (kern_image f) :=
assume a b,
⟨ assume h x hx y hy, have f y ∈ a, from hy.symm ▸ hx, h this,
  assume h x (hx : f x ∈ a), h hx x rfl⟩

end galois_connection

/- union and intersection over a family of sets indexed by a type -/

/-- Indexed union of a family of sets -/
@[reducible] def Union (s : ι → set β) : set β := supr s

/-- Indexed intersection of a family of sets -/
@[reducible] def Inter (s : ι → set β) : set β := infi s

notation `⋃` binders `, ` r:(scoped f, Union f) := r
notation `⋂` binders `, ` r:(scoped f, Inter f) := r

@[simp] theorem mem_Union {x : β} {s : ι → set β} : x ∈ Union s ↔ ∃ i, x ∈ s i :=
⟨assume ⟨t, ⟨⟨a, (t_eq : t = s a)⟩, (h : x ∈ t)⟩⟩, ⟨a, t_eq ▸ h⟩,
  assume ⟨a, h⟩, ⟨s a, ⟨⟨a, rfl⟩, h⟩⟩⟩
/- alternative proof: dsimp [Union, supr, Sup]; simp -/
  -- TODO: more rewrite rules wrt forall / existentials and logical connectives
  -- TODO: also eliminate ∃i, ... ∧ i = t ∧ ...

@[simp] theorem mem_Inter {x : β} {s : ι → set β} : x ∈ Inter s ↔ ∀ i, x ∈ s i :=
⟨assume (h : ∀a ∈ {a : set β | ∃i, a = s i}, x ∈ a) a, h (s a) ⟨a, rfl⟩,
  assume h t ⟨a, (eq : t = s a)⟩, eq.symm ▸ h a⟩

theorem Union_subset {s : ι → set β} {t : set β} (h : ∀ i, s i ⊆ t) : (⋃ i, s i) ⊆ t :=
-- TODO: should be simpler when sets' order is based on lattices
@supr_le (set β) _ set.lattice_set _ _ h

theorem Union_subset_iff {α : Sort u} {s : α → set β} {t : set β} : (⋃ i, s i) ⊆ t ↔ (∀ i, s i ⊆ t):=
⟨assume h i, subset.trans (le_supr s _) h, Union_subset⟩

theorem mem_Inter_of_mem {α : Sort u} {x : β} {s : α → set β} : (∀ i, x ∈ s i) → (x ∈ ⋂ i, s i) :=
assume h t ⟨a, (eq : t = s a)⟩, eq.symm ▸ h a

theorem subset_Inter {t : set β} {s : α → set β} (h : ∀ i, t ⊆ s i) : t ⊆ ⋂ i, s i :=
-- TODO: should be simpler when sets' order is based on lattices
@le_infi (set β) _ set.lattice_set _ _ h

theorem subset_Union : ∀ (s : ι → set β) (i : ι), s i ⊆ (⋃ i, s i) := le_supr

theorem Inter_subset : ∀ (s : ι → set β) (i : ι), (⋂ i, s i) ⊆ s i := infi_le

theorem Union_const [inhabited ι] (s : set β) : (⋃ i:ι, s) = s :=
ext $ by simp

theorem Inter_const [inhabited ι] (s : set β) : (⋂ i:ι, s) = s :=
ext $ by simp

@[simp] -- complete_boolean_algebra
theorem compl_Union (s : ι → set β) : - (⋃ i, s i) = (⋂ i, - s i) :=
ext (by simp)

-- classical -- complete_boolean_algebra
theorem compl_Inter (s : ι → set β) : -(⋂ i, s i) = (⋃ i, - s i) :=
ext (λ x, by simp [classical.not_forall])

-- classical -- complete_boolean_algebra
theorem Union_eq_comp_Inter_comp (s : ι → set β) : (⋃ i, s i) = - (⋂ i, - s i) :=
by simp [compl_Inter, compl_compl]

-- classical -- complete_boolean_algebra
theorem Inter_eq_comp_Union_comp (s : ι → set β) : (⋂ i, s i) = - (⋃ i, -s i) :=
by simp [compl_compl]

theorem inter_Union_left (s : set β) (t : ι → set β) :
  s ∩ (⋃ i, t i) = ⋃ i, s ∩ t i :=
ext $ by simp

theorem inter_Union_right (s : set β) (t : ι → set β) :
  (⋃ i, t i) ∩ s = ⋃ i, t i ∩ s :=
ext $ by simp

theorem Union_union_distrib (s : ι → set β) (t : ι → set β) :
  (⋃ i, s i ∪ t i) = (⋃ i, s i) ∪ (⋃ i, t i) :=
ext $ by simp [exists_or_distrib]

theorem Inter_inter_distrib (s : ι → set β) (t : ι → set β) :
  (⋂ i, s i ∩ t i) = (⋂ i, s i) ∩ (⋂ i, t i) :=
ext $ by simp [forall_and_distrib]

theorem union_Union_left [inhabited ι] (s : set β) (t : ι → set β) :
  s ∪ (⋃ i, t i) = ⋃ i, s ∪ t i :=
by rw [Union_union_distrib, Union_const]

theorem union_Union_right [inhabited ι] (s : set β) (t : ι → set β) :
  (⋃ i, t i) ∪ s = ⋃ i, t i ∪ s :=
by rw [Union_union_distrib, Union_const]

theorem inter_Inter_left [inhabited ι] (s : set β) (t : ι → set β) :
  s ∩ (⋂ i, t i) = ⋂ i, s ∩ t i :=
by rw [Inter_inter_distrib, Inter_const]

theorem inter_Inter_right [inhabited ι] (s : set β) (t : ι → set β) :
  (⋂ i, t i) ∩ s = ⋂ i, t i ∩ s :=
by rw [Inter_inter_distrib, Inter_const]

-- classical
theorem union_Inter_left (s : set β) (t : ι → set β) :
  s ∪ (⋂ i, t i) = ⋂ i, s ∪ t i :=
ext $ assume x, by simp [classical.forall_or_distrib_left]

theorem diff_Union_right (s : set β) (t : ι → set β) :
  (⋃ i, t i) \ s = ⋃ i, t i \ s :=
inter_Union_right _ _

theorem diff_Union_left [inhabited ι] (s : set β) (t : ι → set β) :
  s \ (⋃ i, t i) = ⋂ i, s \ t i :=
by rw [diff_eq, compl_Union, inter_Inter_left]; refl

theorem diff_Inter_left (s : set β) (t : ι → set β) :
  s \ (⋂ i, t i) = ⋃ i, s \ t i :=
by rw [diff_eq, compl_Inter, inter_Union_left]; refl

/- bounded unions and intersections -/

theorem mem_bUnion_iff {s : set α} {t : α → set β} {y : β} :
  y ∈ (⋃ x ∈ s, t x) ↔ ∃ x, x ∈ s ∧ y ∈ t x := by simp

theorem mem_bInter_iff {s : set α} {t : α → set β} {y : β} :
  y ∈ (⋂ x ∈ s, t x) ↔ ∀ x ∈ s, y ∈ t x := by simp

theorem mem_bUnion {s : set α} {t : α → set β} {x : α} {y : β} (xs : x ∈ s) (ytx : y ∈ t x) :
  y ∈ ⋃ x ∈ s, t x :=
by simp; exact ⟨x, ⟨xs, ytx⟩⟩

theorem mem_bInter {s : set α} {t : α → set β} {y : β} (h : ∀ x ∈ s, y ∈ t x) :
  y ∈ ⋂ x ∈ s, t x :=
by simp; assumption

theorem bUnion_subset {s : set α} {t : set β} {u : α → set β} (h : ∀ x ∈ s, u x ⊆ t) :
  (⋃ x ∈ s, u x) ⊆ t :=
show (⨆ x ∈ s, u x) ≤ t, -- TODO: should not be necessary when sets' order is based on lattices
  from supr_le $ assume x, supr_le (h x)

theorem subset_bInter {s : set α} {t : set β} {u : α → set β} (h : ∀ x ∈ s, t ⊆ u x) :
  t ⊆ (⋂ x ∈ s, u x) :=
show t ≤ (⨅ x ∈ s, u x), -- TODO: should not be necessary when sets' order is based on lattices
  from le_infi $ assume x, le_infi (h x)

theorem subset_bUnion_of_mem {s : set α} {u : α → set β} {x : α} (xs : x ∈ s) :
  u x ⊆ (⋃ x ∈ s, u x) :=
show u x ≤ (⨆ x ∈ s, u x),
  from le_supr_of_le x $ le_supr _ xs

theorem bInter_subset_of_mem {s : set α} {t : α → set β} {x : α} (xs : x ∈ s) :
  (⋂ x ∈ s, t x) ⊆ t x :=
show (⨅x ∈ s, t x) ≤ t x,
  from infi_le_of_le x $ infi_le _ xs

theorem bUnion_subset_bUnion_left {s s' : set α} {t : α → set β}
  (h : s ⊆ s') : (⋃ x ∈ s, t x) ⊆ (⋃ x ∈ s', t x) :=
bUnion_subset (λ x xs, subset_bUnion_of_mem (h xs))

theorem bInter_subset_bInter_left {s s' : set α} {t : α → set β}
  (h : s' ⊆ s) : (⋂ x ∈ s, t x) ⊆ (⋂ x ∈ s', t x) :=
subset_bInter (λ x xs, bInter_subset_of_mem (h xs))

theorem bUnion_subset_bUnion_right {s : set α} {t1 t2 : α → set β}
  (h : ∀ x ∈ s, t1 x ⊆ t2 x) : (⋃ x ∈ s, t1 x) ⊆ (⋃ x ∈ s, t2 x) :=
bUnion_subset (λ x xs, subset.trans (h x xs) (subset_bUnion_of_mem xs))

theorem bInter_subset_bInter_right {s : set α} {t1 t2 : α → set β}
  (h : ∀ x ∈ s, t1 x ⊆ t2 x) : (⋂ x ∈ s, t1 x) ⊆ (⋂ x ∈ s, t2 x) :=
subset_bInter (λ x xs, subset.trans (bInter_subset_of_mem xs) (h x xs))

theorem bUnion_eq_Union (s : set α) (t : α → set β) : (⋃ x ∈ s, t x) = (⋃ x : s, t x.1) :=
set.ext $ by simp

theorem bInter_eq_Inter (s : set α) (t : α → set β) : (⋂ x ∈ s, t x) = (⋂ x : s, t x.1) :=
set.ext $ by simp

@[simp] theorem bInter_empty (u : α → set β) : (⋂ x ∈ (∅ : set α), u x) = univ :=
show (⨅x ∈ (∅ : set α), u x) = ⊤, -- simplifier should be able to rewrite x ∈ ∅ to false.
  from infi_emptyset

@[simp] theorem bInter_univ (u : α → set β) : (⋂ x ∈ @univ α, u x) = ⋂ x, u x :=
infi_univ

-- TODO(Jeremy): here is an artifact of the the encoding of bounded intersection:
-- without dsimp, the next theorem fails to type check, because there is a lambda
-- in a type that needs to be contracted. Using simp [eq_of_mem_singleton xa] also works.

@[simp] theorem bInter_singleton (a : α) (s : α → set β) : (⋂ x ∈ ({a} : set α), s x) = s a :=
show (⨅ x ∈ ({a} : set α), s x) = s a, by simp

theorem bInter_union (s t : set α) (u : α → set β) :
  (⋂ x ∈ s ∪ t, u x) = (⋂ x ∈ s, u x) ∩ (⋂ x ∈ t, u x) :=
show (⨅ x ∈ s ∪ t, u x) = (⨅ x ∈ s, u x) ⊓ (⨅ x ∈ t, u x),
  from infi_union

-- TODO(Jeremy): simp [insert_eq, bInter_union] doesn't work
@[simp] theorem bInter_insert (a : α) (s : set α) (t : α → set β) :
  (⋂ x ∈ insert a s, t x) = t a ∩ (⋂ x ∈ s, t x) :=
begin rw insert_eq, simp [bInter_union] end

-- TODO(Jeremy): another example of where an annotation is needed

theorem bInter_pair (a b : α) (s : α → set β) :
  (⋂ x ∈ ({a, b} : set α), s x) = s a ∩ s b :=
by rw insert_of_has_insert; simp [inter_comm]

@[simp] theorem bUnion_empty (s : α → set β) : (⋃ x ∈ (∅ : set α), s x) = ∅ :=
supr_emptyset

@[simp] theorem bUnion_univ (s : α → set β) : (⋃ x ∈ @univ α, s x) = ⋃ x, s x :=
supr_univ

@[simp] theorem bUnion_singleton (a : α) (s : α → set β) : (⋃ x ∈ ({a} : set α), s x) = s a :=
supr_singleton

theorem bUnion_union (s t : set α) (u : α → set β) :
  (⋃ x ∈ s ∪ t, u x) = (⋃ x ∈ s, u x) ∪ (⋃ x ∈ t, u x) :=
supr_union

-- TODO(Jeremy): once again, simp doesn't do it alone.

@[simp] theorem bUnion_insert (a : α) (s : set α) (t : α → set β) :
  (⋃ x ∈ insert a s, t x) = t a ∪ (⋃ x ∈ s, t x) :=
begin rw [insert_eq], simp [bUnion_union] end

theorem bUnion_pair (a b : α) (s : α → set β) :
  (⋃ x ∈ ({a, b} : set α), s x) = s a ∪ s b :=
by rw insert_of_has_insert; simp [union_comm]

@[simp] -- complete_boolean_algebra
theorem compl_bUnion (s : set α) (t : α → set β) : - (⋃ i ∈ s, t i) = (⋂ i ∈ s, - t i) :=
ext (λ x, by simp)

-- classical -- complete_boolean_algebra
theorem compl_bInter (s : set α) (t : α → set β) : -(⋂ i ∈ s, t i) = (⋃ i ∈ s, - t i) :=
ext (λ x, by simp [classical.not_forall])

/-- Intersection of a set of sets. -/
@[reducible] def sInter (S : set (set α)) : set α := Inf S

prefix `⋂₀`:110 := sInter

theorem mem_sUnion_of_mem {x : α} {t : set α} {S : set (set α)} (hx : x ∈ t) (ht : t ∈ S) :
  x ∈ ⋃₀ S :=
⟨t, ⟨ht, hx⟩⟩

@[simp] theorem mem_sUnion {x : α} {S : set (set α)} : x ∈ ⋃₀ S ↔ ∃t ∈ S, x ∈ t := iff.rfl

-- is this theorem really necessary?
theorem not_mem_of_not_mem_sUnion {x : α} {t : set α} {S : set (set α)}
  (hx : x ∉ ⋃₀ S) (ht : t ∈ S) : x ∉ t :=
λ h, hx ⟨t, ht, h⟩

@[simp] theorem mem_sInter {x : α} {S : set (set α)} : x ∈ ⋂₀ S ↔ ∀ t ∈ S, x ∈ t := iff.rfl

theorem sInter_subset_of_mem {S : set (set α)} {t : set α} (tS : t ∈ S) : ⋂₀ S ⊆ t :=
Inf_le tS

theorem subset_sUnion_of_mem {S : set (set α)} {t : set α} (tS : t ∈ S) : t ⊆ ⋃₀ S :=
le_Sup tS

theorem sUnion_subset {S : set (set α)} {t : set α} (h : ∀t' ∈ S, t' ⊆ t) : (⋃₀ S) ⊆ t :=
Sup_le h

theorem sUnion_subset_iff {s : set (set α)} {t : set α} : ⋃₀ s ⊆ t ↔ ∀t' ∈ s, t' ⊆ t :=
⟨assume h t' ht', subset.trans (subset_sUnion_of_mem ht') h, sUnion_subset⟩

theorem subset_sInter {S : set (set α)} {t : set α} (h : ∀t' ∈ S, t ⊆ t') : t ⊆ (⋂₀ S) :=
le_Inf h

theorem sUnion_subset_sUnion {S T : set (set α)} (h : S ⊆ T) : ⋃₀ S ⊆ ⋃₀ T :=
sUnion_subset $ λ s hs, subset_sUnion_of_mem (h hs)

theorem sInter_subset_sInter {S T : set (set α)} (h : S ⊆ T) : ⋂₀ T ⊆ ⋂₀ S :=
subset_sInter $ λ s hs, sInter_subset_of_mem (h hs)

@[simp] theorem sUnion_empty : ⋃₀ ∅ = (∅ : set α) := Sup_empty

@[simp] theorem sInter_empty : ⋂₀ ∅ = (univ : set α) := Inf_empty

@[simp] theorem sUnion_singleton (s : set α) : ⋃₀ {s} = s := Sup_singleton

@[simp] theorem sInter_singleton (s : set α) : ⋂₀ {s} = s := Inf_singleton

theorem sUnion_union (S T : set (set α)) : ⋃₀ (S ∪ T) = ⋃₀ S ∪ ⋃₀ T := Sup_union

theorem sInter_union (S T : set (set α)) : ⋂₀ (S ∪ T) = ⋂₀ S ∩ ⋂₀ T := Inf_union

@[simp] theorem sUnion_insert (s : set α) (T : set (set α)) : ⋃₀ (insert s T) = s ∪ ⋃₀ T := Sup_insert

@[simp] theorem sInter_insert (s : set α) (T : set (set α)) : ⋂₀ (insert s T) = s ∩ ⋂₀ T := Inf_insert

@[simp] theorem sUnion_image (f : α → set β) (s : set α) : ⋃₀ (f '' s) = ⋃ x ∈ s, f x := Sup_image

@[simp] theorem sInter_image (f : α → set β) (s : set α) : ⋂₀ (f '' s) = ⋂ x ∈ s, f x := Inf_image

theorem compl_sUnion (S : set (set α)) :
  - ⋃₀ S = ⋂₀ (compl '' S) :=
set.ext $ assume x,
  ⟨assume : ¬ (∃s∈S, x ∈ s), assume s h,
    match s, h with
    ._, ⟨t, hs, rfl⟩ := assume h, this ⟨t, hs, h⟩
    end,
    assume : ∀s, s ∈ compl '' S → x ∈ s,
    assume ⟨t, tS, xt⟩, this (compl t) (mem_image_of_mem _ tS) xt⟩

-- classical
theorem sUnion_eq_compl_sInter_compl (S : set (set α)) :
  ⋃₀ S = - ⋂₀ (compl '' S) :=
by rw [←compl_compl (⋃₀ S), compl_sUnion]

-- classical
theorem compl_sInter (S : set (set α)) :
  - ⋂₀ S = ⋃₀ (compl '' S) :=
by rw [sUnion_eq_compl_sInter_compl, compl_compl_image]

-- classical
theorem sInter_eq_comp_sUnion_compl (S : set (set α)) :
   ⋂₀ S = -(⋃₀ (compl '' S)) :=
by rw [←compl_compl (⋂₀ S), compl_sInter]

theorem inter_empty_of_inter_sUnion_empty {s t : set α} {S : set (set α)} (hs : t ∈ S)
    (h : s ∩ ⋃₀ S = ∅) :
  s ∩ t = ∅ :=
eq_empty_of_subset_empty $ by rw ← h; exact
inter_subset_inter_right _ (subset_sUnion_of_mem hs)

theorem Union_eq_sUnion_range (s : α → set β) : (⋃ i, s i) = ⋃₀ (range s) :=
by rw [← image_univ, sUnion_image]; simp

theorem Inter_eq_sInter_range {α I : Type} (s : I → set α) : (⋂ i, s i) = ⋂₀ (range s) :=
by rw [← image_univ, sInter_image]; simp

theorem range_sigma_eq_Union_range {γ : α → Type*} (f : sigma γ → β) :
  range f = ⋃ a, range (λ b, f ⟨a, b⟩) :=
set.ext $ by simp

theorem Union_eq_range_sigma (s : α → set β) : (⋃ i, s i) = range (λ a : Σ i, s i, a.2) :=
by simp [set.ext_iff]

lemma sUnion_mono {s t : set (set α)} (h : s ⊆ t) : (⋃₀ s) ⊆ (⋃₀ t) :=
sUnion_subset $ assume t' ht', subset_sUnion_of_mem $ h ht'

lemma Union_subset_Union {s t : ι → set α} (h : ∀i, s i ⊆ t i) : (⋃i, s i) ⊆ (⋃i, t i) :=
@supr_le_supr (set α) ι _ s t h

lemma Union_subset_Union2 {ι₂ : Sort*} {s : ι → set α} {t : ι₂ → set α} (h : ∀i, ∃j, s i ⊆ t j) :
  (⋃i, s i) ⊆ (⋃i, t i) :=
@supr_le_supr2 (set α) ι ι₂ _ s t h

lemma Union_subset_Union_const {ι₂ : Sort x} {s : set α} (h : ι → ι₂) : (⋃ i:ι, s) ⊆ (⋃ j:ι₂, s) :=
@supr_le_supr_const (set α) ι ι₂ _ s h

lemma sUnion_eq_bUnion {s : set (set α)} : (⋃₀ s) = (⋃ (i : set α) (h : i ∈ s), i) :=
set.ext $ by simp

lemma sInter_eq_bInter {s : set (set α)} : (⋂₀ s) = (⋂ (i : set α) (h : i ∈ s), i) :=
set.ext $ by simp

lemma sUnion_eq_Union {s : set (set α)} : (⋃₀ s) = (⋃ (i : s), i.1) :=
set.ext $ λ x, by simp

lemma sInter_eq_Inter {s : set (set α)} : (⋂₀ s) = (⋂ (i : s), i.1) :=
set.ext $ λ x, by simp

lemma union_eq_Union {s₁ s₂ : set α} : s₁ ∪ s₂ = ⋃ b : bool, cond b s₁ s₂ :=
set.ext $ λ x, by simp [bool.exists_bool, or_comm]

lemma inter_eq_Inter {s₁ s₂ : set α} : s₁ ∩ s₂ = ⋂ b : bool, cond b s₁ s₂ :=
set.ext $ λ x, by simp [bool.forall_bool, and_comm]

instance : complete_boolean_algebra (set α) :=
{ neg                 := compl,
  sub                 := (\),
  inf_neg_eq_bot      := assume s, ext $ assume x, ⟨assume ⟨h, nh⟩, nh h, false.elim⟩,
  sup_neg_eq_top      := assume s, ext $ assume x, ⟨assume h, trivial, assume _, classical.em $ x ∈ s⟩,
  le_sup_inf          := distrib_lattice.le_sup_inf,
  sub_eq              := assume x y, rfl,
  infi_sup_le_sup_Inf := assume s t x, show x ∈ (⋂ b ∈ t, s ∪ b) → x ∈ s ∪ (⋂₀ t),
    by simp; exact assume h,
      or.imp_right
        (assume hn : x ∉ s, assume i hi, or.resolve_left (h i hi) hn)
        (classical.em $ x ∈ s),
  inf_Sup_le_supr_inf := assume s t x, show x ∈ s ∩ (⋃₀ t) → x ∈ (⋃ b ∈ t, s ∩ b),
    by simp [-and_imp, and.left_comm],
  ..set.lattice_set }

@[simp] theorem sub_eq_diff (s t : set α) : s - t = s \ t := rfl

section

variables {p : Prop} {μ : p → set α}

@[simp] lemma Inter_pos (hp : p) : (⋂h:p, μ h) = μ hp := infi_pos hp

@[simp] lemma Inter_neg (hp : ¬ p) : (⋂h:p, μ h) = univ := infi_neg hp

@[simp] lemma Union_pos (hp : p) : (⋃h:p, μ h) = μ hp := supr_pos hp

@[simp] lemma Union_neg (hp : ¬ p) : (⋃h:p, μ h) = ∅ := supr_neg hp

@[simp] lemma Union_empty {ι : Sort*} : (⋃i:ι, ∅:set α) = ∅ := supr_bot

@[simp] lemma Inter_univ {ι : Sort*} : (⋂i:ι, univ:set α) = univ := infi_top

end

section image

lemma image_Union {f : α → β} {s : ι → set α} : f '' (⋃ i, s i) = (⋃i, f '' s i) :=
begin
  apply set.ext, intro x,
  simp [image, exists_and_distrib_right.symm, -exists_and_distrib_right],
  exact exists_swap
end

lemma univ_subtype {p : α → Prop} : (univ : set (subtype p)) = (⋃x (h : p x), {⟨x, h⟩})  :=
set.ext $ assume ⟨x, h⟩, by simp [h]

end image

section preimage

theorem monotone_preimage {f : α → β} : monotone (preimage f) := assume a b h, preimage_mono h

@[simp] theorem preimage_Union {ι : Sort w} {f : α → β} {s : ι → set β} :
  preimage f (⋃i, s i) = (⋃i, preimage f (s i)) :=
set.ext $ by simp [preimage]

@[simp] theorem preimage_sUnion {f : α → β} {s : set (set β)} :
  preimage f (⋃₀ s) = (⋃t ∈ s, preimage f t) :=
set.ext $ by simp [preimage]

end preimage

section seq

def seq (s : set (α → β)) (t : set α) : set β := {b | ∃f∈s, ∃a∈t, (f : α → β) a = b}

lemma seq_def {s : set (α → β)} {t : set α} : seq s t = ⋃f∈s, f '' t :=
set.ext $ by simp [seq]

lemma mem_seq_iff {s : set (α → β)} {t : set α} {b : β} :
  b ∈ seq s t ↔ (∃f ∈ s, ∃a∈t, (f : α → β) a = b) :=
iff.refl _

lemma seq_subset {s : set (α → β)} {t : set α} {u : set β} :
  seq s t ⊆ u ↔ (∀f∈s, ∀a∈t, (f : α → β) a ∈ u) :=
iff.intro
  (assume h f hf a ha, h ⟨f, hf, a, ha, rfl⟩)
  (assume h b ⟨f, hf, a, ha, eq⟩, eq ▸ h f hf a ha)

lemma seq_mono {s₀ s₁ : set (α → β)} {t₀ t₁ : set α} (hs : s₀ ⊆ s₁) (ht : t₀ ⊆ t₁) :
  seq s₀ t₀ ⊆ seq s₁ t₁ :=
assume b ⟨f, hf, a, ha, eq⟩, ⟨f, hs hf, a, ht ha, eq⟩

lemma singleton_seq {f : α → β} {t : set α} : set.seq {f} t = f '' t :=
set.ext $ by simp [seq]

lemma seq_singleton {s : set (α → β)} {a : α} : set.seq s {a} = (λf:α→β, f a) '' s :=
set.ext $ by simp [seq]

lemma seq_seq {s : set (β → γ)} {t : set (α → β)} {u : set α} :
  seq s (seq t u) = seq (seq ((∘) '' s) t) u :=
begin
  refine (set.ext $ assume c, iff.intro _ _),
  { rintros ⟨f, hfs, b, ⟨g, hg, a, hau, rfl⟩, rfl⟩,
    exact ⟨f ∘ g, ⟨(∘) f, mem_image_of_mem _ hfs, g, hg, rfl⟩, a, hau, rfl⟩ },
  { rintros ⟨fg, ⟨fc, ⟨f, hfs, rfl⟩, g, hgt, rfl⟩, a, ha, rfl⟩,
    exact ⟨f, hfs, g a, ⟨g, hgt, a, ha, rfl⟩ , rfl⟩ }
end

lemma image_seq {f : β → γ} {s : set (α → β)} {t : set α} :
  f '' seq s t = seq ((∘) f '' s) t :=
by rw [← singleton_seq, ← singleton_seq, seq_seq, image_singleton]

lemma prod_eq_seq {s : set α} {t : set β} : set.prod s t = (prod.mk '' s).seq t :=
begin
  ext ⟨a, b⟩,
  split,
  { rintros ⟨ha, hb⟩, exact ⟨prod.mk a, ⟨a, ha, rfl⟩, b, hb, rfl⟩ },
  { rintros ⟨f, ⟨x, hx, rfl⟩, y, hy, eq⟩, rw ← eq, exact ⟨hx, hy⟩ }
end

lemma prod_image_seq_comm (s : set α) (t : set β) :
  (prod.mk '' s).seq t = seq ((λb a, (a, b)) '' t) s :=
by rw [← prod_eq_seq, ← image_swap_prod, prod_eq_seq, image_seq, ← image_comp]

end seq

theorem monotone_prod [preorder α] {f : α → set β} {g : α → set γ}
  (hf : monotone f) (hg : monotone g) : monotone (λx, set.prod (f x) (g x)) :=
assume a b h, prod_mono (hf h) (hg h)

instance : monad set :=
{ pure       := λ(α : Type u) a, {a},
  bind       := λ(α β : Type u) s f, ⋃i∈s, f i,
  seq        := λ(α β : Type u), set.seq,
  map        := λ(α β : Type u), set.image }

instance : is_lawful_monad set :=
{ pure_bind             := assume α β x f, by simp,
  bind_assoc            := assume α β γ s f g, set.ext $ assume a,
    by simp [exists_and_distrib_right.symm, -exists_and_distrib_right,
             exists_and_distrib_left.symm, -exists_and_distrib_left, and_assoc];
       exact exists_swap,
  id_map                := assume α, id_map,
  bind_pure_comp_eq_map := assume α β f s, set.ext $ by simp [set.image, eq_comm],
  bind_map_eq_seq       := assume α β s t, by simp [seq_def] }

instance : is_comm_applicative (set : Type u → Type u) :=
⟨ assume α β s t, prod_image_seq_comm s t ⟩

section monad
variables {α' β' : Type u} {s : set α'} {f : α' → set β'} {g : set (α' → β')}

@[simp] lemma bind_def : s >>= f = ⋃i∈s, f i := rfl

lemma fmap_eq_image : f <$> s = f '' s := rfl

lemma seq_eq_set_seq {α β : Type*} (s : set (α → β)) (t : set α) : s <*> t = s.seq t := rfl

@[simp] lemma pure_def (a : α): (pure a : set α) = {a} := rfl

end monad

section pi

lemma pi_def {α : Type*} {π : α → Type*} (i : set α) (s : Πa, set (π a)) :
  pi i s = (⋂ a∈i, ((λf:(Πa, π a), f a) ⁻¹' (s a))) :=
by ext; simp [pi]

end pi

end set

/- disjoint sets -/

section disjoint
variable [semilattice_inf_bot α]
/-- Two elements of a lattice are disjoint if their inf is the bottom element.
  (This generalizes disjoint sets, viewed as members of the subset lattice.) -/
def disjoint (a b : α) : Prop := a ⊓ b ≤ ⊥

theorem disjoint.eq_bot {a b : α} (h : disjoint a b) : a ⊓ b = ⊥ :=
eq_bot_iff.2 h

theorem disjoint_iff {a b : α} : disjoint a b ↔ a ⊓ b = ⊥ :=
eq_bot_iff.symm

theorem disjoint.comm {a b : α} : disjoint a b ↔ disjoint b a :=
by rw [disjoint, disjoint, inf_comm]

theorem disjoint.symm {a b : α} : disjoint a b → disjoint b a :=
disjoint.comm.1

theorem disjoint_bot_left {a : α} : disjoint ⊥ a := disjoint_iff.2 bot_inf_eq
theorem disjoint_bot_right {a : α} : disjoint a ⊥ := disjoint_iff.2 inf_bot_eq

theorem disjoint_mono {a b c d : α} (h₁ : a ≤ b) (h₂ : c ≤ d) :
  disjoint b d → disjoint a c := le_trans (inf_le_inf h₁ h₂)

theorem disjoint_mono_left {a b c : α} (h : a ≤ b) : disjoint b c → disjoint a c :=
disjoint_mono h (le_refl _)

theorem disjoint_mono_right {a b c : α} (h : b ≤ c) : disjoint a c → disjoint a b :=
disjoint_mono (le_refl _) h

end disjoint

theorem set.disjoint_diff {a b : set α} : disjoint a (b \ a) :=
disjoint_iff.2 (inter_diff_self _ _)

section
open set
set_option eqn_compiler.zeta true

noncomputable def set.bUnion_eq_sigma_of_disjoint {α β} {s : set α} {t : α → set β}
  (h : pairwise_on s (disjoint on t)) : (⋃i∈s, t i) ≃ (Σi:s, t i.val) :=
let f : (Σi:s, t i.val) → (⋃i∈s, t i) := λ⟨⟨a, ha⟩, ⟨b, hb⟩⟩, ⟨b, mem_bUnion ha hb⟩ in
have injective f,
  from assume ⟨⟨a₁, ha₁⟩, ⟨b₁, hb₁⟩⟩ ⟨⟨a₂, ha₂⟩, ⟨b₂, hb₂⟩⟩ eq,
  have b_eq : b₁ = b₂, from congr_arg subtype.val eq,
  have a_eq : a₁ = a₂, from classical.by_contradiction $ assume ne,
    have b₁ ∈ t a₁ ∩ t a₂, from ⟨hb₁, b_eq.symm ▸ hb₂⟩,
    h _ ha₁ _ ha₂ ne this,
  sigma.eq (subtype.eq a_eq) (subtype.eq $ by subst b_eq; subst a_eq),
have surjective f,
  from assume ⟨b, hb⟩,
  have ∃a∈s, b ∈ t a, by simpa using hb,
  let ⟨a, ha, hb⟩ := this in ⟨⟨⟨a, ha⟩, ⟨b, hb⟩⟩, rfl⟩,
(equiv.of_bijective ⟨‹injective f›, ‹surjective f›⟩).symm

end


import game.world3.level6 -- hide
namespace mynat -- hide

/-
# Multiplication World

## Level 7: `add_mul`

We proved `mul_add` already, but because we don't have commutativity yet
we also need to prove `add_mul`. We have a bunch of tools now, so this won't
be too hard. You know what -- you can do this one by induction on any of
the variables. Try them all! Which works best? If you can't face
doing all the commutativity and associativity, remember the high-powered
`simp` tactic mentioned at the bottom of Addition World level 6,
which will solve any puzzle which needs only commutativity
and associativity. If your goal looks like `a+(b+c)=c+b+a` or something,
don't mess around doing it explicitly with `add_comm` and `add_assoc`,
just try `simp`.
-/

/- Lemma
Addition is distributive over multiplication.
In other words, for all natural numbers $a$, $b$ and $t$, we have
$$ (a + b) \times t = at + bt. $$
-/
lemma add_mul (a b t : mynat) : (a + b) * t = a * t + b * t :=
begin [nat_num_game]
  induction b with d hd,
  {
    rw zero_mul,
    rw add_zero,
    rw add_zero,
    refl
  },
  {
    rw add_succ,
    rw succ_mul,
    rw hd,
    rw succ_mul,
    rw add_assoc,
    refl
  }
end

/-
A mathematician would now say that you have proved that the natural
numbers are a semiring. This sounds like a respectable result.
-/

def right_distrib := add_mul -- alternative name
instance : semiring mynat := by structure_helper

/-
Lean would add that you have also proved that they are a `distrib`.
However this concept has no mathematical name at all -- this says something
about the regard with which mathematicians hold this collectible.
This is an artefact of the set-up of collectibles in Lean. You consider politely
declining Lean's offer of a `distrib` collectible.
You are dreaming of the big collectible at the end of power world.
-/

instance : distrib mynat := by structure_helper --

end mynat -- hide


/-
Copyright (c) 2021 Yury G. Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury G. Kudryashov
-/
import analysis.complex.circle
import analysis.special_functions.complex.log

/-!
# Maps on the unit circle

In this file we prove some basic lemmas about `exp_map_circle` and the restriction of `complex.arg`
to the unit circle. These two maps define a local equivalence between `circle` and `ℝ`, see
`circle.arg_local_equiv` and `circle.arg_equiv`, that sends the whole circle to `(-π, π]`.
-/

open complex function set
open_locale real

namespace circle

lemma injective_arg : injective (λ z : circle, arg z) :=
λ z w h, subtype.ext $ ext_abs_arg ((abs_coe_circle z).trans (abs_coe_circle w).symm) h

@[simp] lemma arg_eq_arg {z w : circle} : arg z = arg w ↔ z = w := injective_arg.eq_iff

end circle

lemma arg_exp_map_circle {x : ℝ} (h₁ : -π < x) (h₂ : x ≤ π) : arg (exp_map_circle x) = x :=
by rw [exp_map_circle_apply, exp_mul_I, arg_cos_add_sin_mul_I ⟨h₁, h₂⟩]

@[simp] lemma exp_map_circle_arg (z : circle) : exp_map_circle (arg z) = z :=
circle.injective_arg $ arg_exp_map_circle (neg_pi_lt_arg _) (arg_le_pi _)

namespace circle

/-- `complex.arg ∘ coe` and `exp_map_circle` define a local equivalence between `circle and `ℝ` with
`source = set.univ` and `target = set.Ioc (-π) π`. -/
@[simps { fully_applied := ff }]
noncomputable def arg_local_equiv : local_equiv circle ℝ :=
{ to_fun := arg ∘ coe,
  inv_fun := exp_map_circle,
  source := univ,
  target := Ioc (-π) π,
  map_source' := λ z _, ⟨neg_pi_lt_arg _, arg_le_pi _⟩,
  map_target' := maps_to_univ _ _,
  left_inv' := λ z _, exp_map_circle_arg z,
  right_inv' := λ x hx, arg_exp_map_circle hx.1 hx.2 }

/-- `complex.arg` and `exp_map_circle` define an equivalence between `circle and `(-π, π]`. -/
@[simps { fully_applied := ff }]
noncomputable def arg_equiv : circle ≃ Ioc (-π) π :=
{ to_fun := λ z, ⟨arg z, neg_pi_lt_arg _, arg_le_pi _⟩,
  inv_fun := exp_map_circle ∘ coe,
  left_inv := λ z, arg_local_equiv.left_inv trivial,
  right_inv := λ x, subtype.ext $ arg_local_equiv.right_inv x.2 }

end circle

lemma left_inverse_exp_map_circle_arg : left_inverse exp_map_circle (arg ∘ coe) :=
exp_map_circle_arg

lemma inv_on_arg_exp_map_circle : inv_on (arg ∘ coe) exp_map_circle (Ioc (-π) π) univ :=
circle.arg_local_equiv.symm.inv_on

lemma surj_on_exp_map_circle_neg_pi_pi : surj_on exp_map_circle (Ioc (-π) π) univ :=
circle.arg_local_equiv.symm.surj_on

lemma exp_map_circle_eq_exp_map_circle {x y : ℝ} :
  exp_map_circle x = exp_map_circle y ↔ ∃ m : ℤ, x = y + m * (2 * π) :=
begin
  rw [subtype.ext_iff, exp_map_circle_apply, exp_map_circle_apply, exp_eq_exp_iff_exists_int],
  refine exists_congr (λ n, _),
  rw [← mul_assoc, ← add_mul, mul_left_inj' I_ne_zero, ← of_real_one, ← of_real_bit0,
    ← of_real_mul, ← of_real_int_cast, ← of_real_mul, ← of_real_add, of_real_inj]
end

lemma periodic_exp_map_circle : periodic exp_map_circle (2 * π) :=
λ z, exp_map_circle_eq_exp_map_circle.2 ⟨1, by rw [int.cast_one, one_mul]⟩

@[simp] lemma exp_map_circle_two_pi : exp_map_circle (2 * π) = 1 :=
periodic_exp_map_circle.eq.trans exp_map_circle_zero

lemma exp_map_circle_sub_two_pi (x : ℝ) : exp_map_circle (x - 2 * π) = exp_map_circle x :=
periodic_exp_map_circle.sub_eq x

lemma exp_map_circle_add_two_pi (x : ℝ) : exp_map_circle (x + 2 * π) = exp_map_circle x :=
periodic_exp_map_circle x

/-- `exp_map_circle`, applied to a `real.angle`. -/
noncomputable def real.angle.exp_map_circle (θ : real.angle) : circle :=
periodic_exp_map_circle.lift θ

@[simp] lemma real.angle.exp_map_circle_coe (x : ℝ) :
  real.angle.exp_map_circle x = exp_map_circle x :=
rfl

lemma real.angle.coe_exp_map_circle (θ : real.angle) : (θ.exp_map_circle : ℂ) = θ.cos + θ.sin * I :=
begin
  induction θ using real.angle.induction_on,
  simp [complex.exp_mul_I],
end

@[simp] lemma real.angle.exp_map_circle_zero :
  real.angle.exp_map_circle 0 = 1 :=
by rw [←real.angle.coe_zero, real.angle.exp_map_circle_coe, exp_map_circle_zero]

@[simp] lemma real.angle.exp_map_circle_neg (θ : real.angle) :
  real.angle.exp_map_circle (-θ) = (real.angle.exp_map_circle θ)⁻¹ :=
begin
  induction θ using real.angle.induction_on,
  simp_rw [←real.angle.coe_neg, real.angle.exp_map_circle_coe, exp_map_circle_neg]
end

@[simp] lemma real.angle.exp_map_circle_add (θ₁ θ₂ : real.angle) :
  real.angle.exp_map_circle (θ₁ + θ₂) =
    (real.angle.exp_map_circle θ₁) * (real.angle.exp_map_circle θ₂) :=
begin
  induction θ₁ using real.angle.induction_on,
  induction θ₂ using real.angle.induction_on,
  exact exp_map_circle_add θ₁ θ₂
end

@[simp] lemma real.angle.arg_exp_map_circle (θ : real.angle) :
  (arg (real.angle.exp_map_circle θ) : real.angle) = θ :=
begin
  induction θ using real.angle.induction_on,
  rw [real.angle.exp_map_circle_coe, exp_map_circle_apply, exp_mul_I, ←of_real_cos,
      ←of_real_sin, ←real.angle.cos_coe, ←real.angle.sin_coe, arg_cos_add_sin_mul_I_coe_angle]
end


/-
Copyright (c) 2020 Patrick Stevens. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Patrick Stevens
-/
import algebra.big_operators.associated
import data.nat.choose.sum
import data.nat.parity
import tactic.ring_exp

/-!
# Primorial

This file defines the primorial function (the product of primes less than or equal to some bound),
and proves that `primorial n ≤ 4 ^ n`.

## Notations

We use the local notation `n#` for the primorial of `n`: that is, the product of the primes less
than or equal to `n`.
-/

open finset
open nat
open_locale big_operators nat

/-- The primorial `n#` of `n` is the product of the primes less than or equal to `n`.
-/
def primorial (n : ℕ) : ℕ := ∏ p in (filter nat.prime (range (n + 1))), p
local notation x`#` := primorial x

lemma primorial_succ {n : ℕ} (n_big : 1 < n) (r : n % 2 = 1) : (n + 1)# = n# :=
begin
  refine prod_congr _ (λ _ _, rfl),
  rw [range_succ, filter_insert, if_neg (λ h, _)],
  have two_dvd : 2 ∣ n + 1 := (dvd_iff_mod_eq_zero _ _).mpr (by rw [← mod_add_mod, r, mod_self]),
  linarith [(h.dvd_iff_eq (nat.bit0_ne_one 1)).mp two_dvd],
end

lemma dvd_choose_of_middling_prime (p : ℕ) (is_prime : nat.prime p) (m : ℕ)
  (p_big : m + 1 < p) (p_small : p ≤ 2 * m + 1) : p ∣ choose (2 * m + 1) (m + 1) :=
begin
  have m_size : m + 1 ≤ 2 * m + 1 := le_of_lt (lt_of_lt_of_le p_big p_small),
  have s : ¬(p ∣ (m + 1)!),
  { intros p_div_fact,
    exact lt_le_antisymm p_big (is_prime.dvd_factorial.mp p_div_fact), },
  have t : ¬(p ∣ (2 * m + 1 - (m + 1))!),
  { intros p_div_fact,
    refine lt_le_antisymm (lt_of_succ_lt p_big) _,
    convert is_prime.dvd_factorial.mp p_div_fact,
    rw [two_mul, add_assoc, nat.add_sub_cancel] },
  have expanded :
    choose (2 * m + 1) (m + 1) * (m + 1)! * (2 * m + 1 - (m + 1))! = (2 * m + 1)! :=
    @choose_mul_factorial_mul_factorial (2 * m + 1) (m + 1) m_size,
  have p_div_big_fact : p ∣ (2 * m + 1)! := (prime.dvd_factorial is_prime).mpr p_small,
  rw [←expanded, mul_assoc] at p_div_big_fact,
  obtain p_div_choose | p_div_facts : p ∣ choose (2 * m + 1) (m + 1) ∨ p ∣ _! * _! :=
    (prime.dvd_mul is_prime).1 p_div_big_fact,
  { exact p_div_choose, },
  cases (prime.dvd_mul is_prime).1 p_div_facts,
  exacts [(s h).elim, (t h).elim],
end

lemma primorial_le_4_pow : ∀ (n : ℕ), n# ≤ 4 ^ n
| 0 := le_rfl
| 1 := le_of_inf_eq rfl
| (n + 2) :=
  match nat.mod_two_eq_zero_or_one (n + 1) with
  | or.inl n_odd :=
    match nat.even_iff.2 n_odd with
    | ⟨m, twice_m⟩ :=
      have recurse : m + 1 < n + 2 := by linarith,
      begin
        calc (n + 2)#
            = ∏ i in filter nat.prime (range (2 * m + 2)), i : by simpa [two_mul, ←twice_m]
        ... = ∏ i in filter nat.prime (finset.Ico (m + 2) (2 * m + 2) ∪ range (m + 2)), i :
              begin
                rw [range_eq_Ico, finset.union_comm, finset.Ico_union_Ico_eq_Ico],
                { exact bot_le },
                { simpa only [add_le_add_iff_right, two_mul] using nat.le_add_left m m },
              end
        ... = ∏ i in (filter nat.prime (finset.Ico (m + 2) (2 * m + 2))
              ∪ (filter nat.prime (range (m + 2)))), i :
              by rw filter_union
        ... = (∏ i in filter nat.prime (finset.Ico (m + 2) (2 * m + 2)), i)
              * (∏ i in filter nat.prime (range (m + 2)), i) :
              begin
                apply finset.prod_union,
                have disj : disjoint (finset.Ico (m + 2) (2 * m + 2)) (range (m + 2)),
                { simp only [finset.disjoint_left, and_imp, finset.mem_Ico, not_lt,
                    finset.mem_range],
                  intros _ pr _, exact pr, },
                exact finset.disjoint_filter_filter disj,
              end
        ... ≤ (∏ i in filter nat.prime (finset.Ico (m + 2) (2 * m + 2)), i) * 4 ^ (m + 1) :
              nat.mul_le_mul_left _ (primorial_le_4_pow (m + 1))
        ... ≤ (choose (2 * m + 1) (m + 1)) * 4 ^ (m + 1) :
              begin
                have s : ∏ i in filter nat.prime (finset.Ico (m + 2) (2 * m + 2)),
                  i ∣ choose (2 * m + 1) (m + 1),
                { refine prod_primes_dvd  (choose (2 * m + 1) (m + 1)) _ _,
                  { intros a, rw [finset.mem_filter, nat.prime_iff], apply and.right, },
                  { intros a, rw finset.mem_filter,
                    intros pr,
                    rcases pr with ⟨ size, is_prime ⟩,
                    simp only [finset.mem_Ico] at size,
                    rcases size with ⟨ a_big , a_small ⟩,
                    exact dvd_choose_of_middling_prime a is_prime m a_big
                      (nat.lt_succ_iff.mp a_small), }, },
                have r : ∏ i in filter nat.prime (finset.Ico (m + 2) (2 * m + 2)),
                  i ≤ choose (2 * m + 1) (m + 1),
                { refine @nat.le_of_dvd _ _ _ s,
                  exact @choose_pos (2 * m + 1) (m + 1) (by linarith), },
                exact nat.mul_le_mul_right _ r,
              end
        ... = (choose (2 * m + 1) m) * 4 ^ (m + 1) : by rw choose_symm_half m
        ... ≤ 4 ^ m * 4 ^ (m + 1) : nat.mul_le_mul_right _ (choose_middle_le_pow m)
        ... = 4 ^ (2 * m + 1) : by ring_exp
        ... = 4 ^ (n + 2) : by rw [two_mul, ←twice_m],
      end
    end
  | or.inr n_even :=
    begin
      obtain one_lt_n | n_le_one : 1 < n + 1 ∨ n + 1 ≤ 1 := lt_or_le 1 (n + 1),
      { rw primorial_succ one_lt_n n_even,
        calc (n + 1)#
              ≤ 4 ^ n.succ : primorial_le_4_pow (n + 1)
          ... ≤ 4 ^ (n + 2) : pow_le_pow (by norm_num) (nat.le_succ _), },
      { have n_zero : n = 0 := eq_bot_iff.2 (succ_le_succ_iff.1 n_le_one),
        norm_num [n_zero, primorial, range_succ, prod_filter, nat.not_prime_zero, nat.prime_two] },
    end

end


import data.nat.prime
import tactic.linarith
import algebra.big_operators.order
import data.nat.interval
import data.nat.prime
import data.nat.modeq
import tactic

open_locale big_operators
open nat

/-
(pg 3) Euclid's Proof that there are infiinitely many primes
-/

theorem infinitude_of_primes : ∀ N, ∃ p ≥ N, nat.prime p :=
begin
  intro N,
  let M := nat.factorial N + 1,
  let p := min_fac M ,
  have pp:  nat.prime p := begin
    refine min_fac_prime _,
    have x :   nat.factorial N > 0 := begin
      exact factorial_pos N,
    end,
    linarith,
  end,
  use p,
  split,
  { by_contradiction,
    have np : p ≤ N, from le_of_not_ge h,
    have h1 : p ∣ nat.factorial N,from dvd_factorial (min_fac_pos _) np,
    have h2 : p ∣ 1, from (nat.dvd_add_iff_right h1).2 (min_fac_dvd _),
    exact nat.prime.not_dvd_one pp h2,
    },
  { exact pp }
end

-- define a fermat number
def fermat_number (p : ℕ ) := 2^2^p +1
-- p is a fermat number
def is_fermat_number (p: ℕ ): Prop := ∃ N, fermat_number N = p

lemma fermat_recurrence (n: ℕ) : ∏ x in finset.range n, fermat_number x = fermat_number n - 2 :=
begin
  simp only [fermat_number],
  induction n with n ih,
  { simp },
  { simp only [nat.succ_eq_add_one, finset.prod_range_succ, nat.succ_sub_succ_eq_sub,
      finset.prod_congr, ih],
    rw [mul_comm, ←nat.sq_sub_sq, pow_succ' _ n, pow_mul, one_pow], }
end
lemma fermat_numbers_relatively_prime' :   ∀ a b, is_fermat_number a ∧ is_fermat_number b → nat.coprime a b := begin
  intros a b fa,
  have : a > b := begin
    -- tactic.wlog a b,
    sorry,
  end,
  cases fa,
  have fermat_recurrence := fermat_recurrence,
  by_contradiction,
  let m := gcd a b,
  have x:  m > 1  := sorry,
  have fermat_a:  ∏ (x : ℕ) in finset.range a, fermat_number x = fermat_number a - 2 := begin
    rw fermat_recurrence,
  end,
  have fermat_mod :  (∏ (x : ℕ) in finset.range a, fermat_number x)  ≡ (fermat_number a - 2) [MOD m] := begin
    simp [modeq_iff_dvd],
    sorry,
  end,
  have fermat_mod_l :  (∏ (x : ℕ) in finset.range a, fermat_number x)  ≡ 0 [MOD m] := begin
    rw modeq_iff_dvd,
    norm_num,
    sorry,
  end,
  sorry,
end
-- prove all fermat numbers are coprime
lemma fermat_numbers_relatively_prime :   ∀ a b, is_fermat_number a ∧ is_fermat_number b → nat.coprime a b := begin
  intro a,
  intro b,
  intro fa,
  cases fa,
  let m  := nat.gcd a b,
  have h2 : m ∣ 2 := begin
    refine dvd_of_mem_factors _,
    sorry,
  end,
  have w : m = 1 := begin
  refine nat.dvd_one.mp _,
  refine nat.dvd_one.mpr _,
    sorry,
  end,
  refine coprime_iff_gcd_eq_one.mpr w,
end

/-
(pg 3) Fermat number proof that there are infinitely
many primes
-/
theorem fermat_numbers_infinitely_many_primes : ∀ N, ∃ p ≥ N, nat.prime p :=
begin
 sorry,
end