/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Yury Kudryashov
-/
import dynamics.ergodic.measure_preserving
import linear_algebra.determinant
import linear_algebra.matrix.diagonal
import linear_algebra.matrix.transvection
import measure_theory.constructions.pi
import measure_theory.measure.stieltjes

/-!
# Lebesgue measure on the real line and on `ℝⁿ`

We construct Lebesgue measure on the real line, as a particular case of Stieltjes measure associated
to the function `x ↦ x`. We obtain as a consequence Lebesgue measure on `ℝⁿ`. We prove that they
are translation invariant.

We show that, on `ℝⁿ`, a linear map acts on Lebesgue measure by rescaling it through the absolute
value of its determinant, in `real.map_linear_map_volume_pi_eq_smul_volume_pi`.

More properties of the Lebesgue measure are deduced from this in `haar_lebesgue.lean`, where they
are proved more generally for any additive Haar measure on a finite-dimensional real vector space.
-/

noncomputable theory
open classical set filter measure_theory
open ennreal (of_real)
open_locale big_operators ennreal nnreal topological_space

/-!
### Definition of the Lebesgue measure and lengths of intervals
-/

/-- Lebesgue measure on the Borel sigma algebra, giving measure `b - a` to the interval `[a, b]`. -/
instance real.measure_space : measure_space ℝ :=
⟨stieltjes_function.id.measure⟩

namespace real

variables {ι : Type*} [fintype ι]

open_locale topological_space

theorem volume_val (s) : volume s = stieltjes_function.id.measure s := rfl

@[simp] lemma volume_Ico {a b : ℝ} : volume (Ico a b) = of_real (b - a) :=
by simp [volume_val]

@[simp] lemma volume_Icc {a b : ℝ} : volume (Icc a b) = of_real (b - a) :=
by simp [volume_val]

@[simp] lemma volume_Ioo {a b : ℝ} : volume (Ioo a b) = of_real (b - a) :=
by simp [volume_val]

@[simp] lemma volume_Ioc {a b : ℝ} : volume (Ioc a b) = of_real (b - a) :=
by simp [volume_val]

@[simp] lemma volume_singleton {a : ℝ} : volume ({a} : set ℝ) = 0 :=
by simp [volume_val]

@[simp] lemma volume_univ : volume (univ : set ℝ) = ∞ :=
ennreal.eq_top_of_forall_nnreal_le $ λ r,
  calc (r : ℝ≥0∞) = volume (Icc (0 : ℝ) r) : by simp
              ... ≤ volume univ            : measure_mono (subset_univ _)

@[simp] lemma volume_ball (a r : ℝ) :
  volume (metric.ball a r) = of_real (2 * r) :=
by rw [ball_eq_Ioo, volume_Ioo, ← sub_add, add_sub_cancel', two_mul]

@[simp] lemma volume_closed_ball (a r : ℝ) :
  volume (metric.closed_ball a r) = of_real (2 * r) :=
by rw [closed_ball_eq_Icc, volume_Icc, ← sub_add, add_sub_cancel', two_mul]

@[simp] lemma volume_emetric_ball (a : ℝ) (r : ℝ≥0∞) :
  volume (emetric.ball a r) = 2 * r :=
begin
  rcases eq_or_ne r ∞ with rfl|hr,
  { rw [metric.emetric_ball_top, volume_univ, two_mul, ennreal.top_add] },
  { lift r to ℝ≥0 using hr,
    rw [metric.emetric_ball_nnreal, volume_ball, two_mul, ← nnreal.coe_add,
      ennreal.of_real_coe_nnreal, ennreal.coe_add, two_mul] }
end

@[simp] lemma volume_emetric_closed_ball (a : ℝ) (r : ℝ≥0∞) :
  volume (emetric.closed_ball a r) = 2 * r :=
begin
  rcases eq_or_ne r ∞ with rfl|hr,
  { rw [emetric.closed_ball_top, volume_univ, two_mul, ennreal.top_add] },
  { lift r to ℝ≥0 using hr,
    rw [metric.emetric_closed_ball_nnreal, volume_closed_ball, two_mul, ← nnreal.coe_add,
      ennreal.of_real_coe_nnreal, ennreal.coe_add, two_mul] }
end

instance has_no_atoms_volume : has_no_atoms (volume : measure ℝ) :=
⟨λ x, volume_singleton⟩

@[simp] lemma volume_interval {a b : ℝ} : volume (interval a b) = of_real (|b - a|) :=
by rw [interval, volume_Icc, max_sub_min_eq_abs]

@[simp] lemma volume_Ioi {a : ℝ} : volume (Ioi a) = ∞ :=
top_unique $ le_of_tendsto' ennreal.tendsto_nat_nhds_top $ λ n,
calc (n : ℝ≥0∞) = volume (Ioo a (a + n)) : by simp
... ≤ volume (Ioi a) : measure_mono Ioo_subset_Ioi_self

@[simp] lemma volume_Ici {a : ℝ} : volume (Ici a) = ∞ :=
by simp [← measure_congr Ioi_ae_eq_Ici]

@[simp] lemma volume_Iio {a : ℝ} : volume (Iio a) = ∞ :=
top_unique $ le_of_tendsto' ennreal.tendsto_nat_nhds_top $ λ n,
calc (n : ℝ≥0∞) = volume (Ioo (a - n) a) : by simp
... ≤ volume (Iio a) : measure_mono Ioo_subset_Iio_self

@[simp] lemma volume_Iic {a : ℝ} : volume (Iic a) = ∞ :=
by simp [← measure_congr Iio_ae_eq_Iic]

instance locally_finite_volume : is_locally_finite_measure (volume : measure ℝ) :=
⟨λ x, ⟨Ioo (x - 1) (x + 1),
  is_open.mem_nhds is_open_Ioo ⟨sub_lt_self _ zero_lt_one, lt_add_of_pos_right _ zero_lt_one⟩,
  by simp only [real.volume_Ioo, ennreal.of_real_lt_top]⟩⟩

instance is_finite_measure_restrict_Icc (x y : ℝ) : is_finite_measure (volume.restrict (Icc x y)) :=
⟨by simp⟩

instance is_finite_measure_restrict_Ico (x y : ℝ) : is_finite_measure (volume.restrict (Ico x y)) :=
⟨by simp⟩

instance is_finite_measure_restrict_Ioc (x y : ℝ) : is_finite_measure (volume.restrict (Ioc x y)) :=
 ⟨by simp⟩

instance is_finite_measure_restrict_Ioo (x y : ℝ) : is_finite_measure (volume.restrict (Ioo x y)) :=
⟨by simp⟩

/-!
### Volume of a box in `ℝⁿ`
-/

lemma volume_Icc_pi {a b : ι → ℝ} : volume (Icc a b) = ∏ i, ennreal.of_real (b i - a i) :=
begin
  rw [← pi_univ_Icc, volume_pi_pi],
  simp only [real.volume_Icc]
end

@[simp] lemma volume_Icc_pi_to_real {a b : ι → ℝ} (h : a ≤ b) :
  (volume (Icc a b)).to_real = ∏ i, (b i - a i) :=
by simp only [volume_Icc_pi, ennreal.to_real_prod, ennreal.to_real_of_real (sub_nonneg.2 (h _))]

lemma volume_pi_Ioo {a b : ι → ℝ} :
  volume (pi univ (λ i, Ioo (a i) (b i))) = ∏ i, ennreal.of_real (b i - a i) :=
(measure_congr measure.univ_pi_Ioo_ae_eq_Icc).trans volume_Icc_pi

@[simp] lemma volume_pi_Ioo_to_real {a b : ι → ℝ} (h : a ≤ b) :
  (volume (pi univ (λ i, Ioo (a i) (b i)))).to_real = ∏ i, (b i - a i) :=
by simp only [volume_pi_Ioo, ennreal.to_real_prod, ennreal.to_real_of_real (sub_nonneg.2 (h _))]

lemma volume_pi_Ioc {a b : ι → ℝ} :
  volume (pi univ (λ i, Ioc (a i) (b i))) = ∏ i, ennreal.of_real (b i - a i) :=
(measure_congr measure.univ_pi_Ioc_ae_eq_Icc).trans volume_Icc_pi

@[simp] lemma volume_pi_Ioc_to_real {a b : ι → ℝ} (h : a ≤ b) :
  (volume (pi univ (λ i, Ioc (a i) (b i)))).to_real = ∏ i, (b i - a i) :=
by simp only [volume_pi_Ioc, ennreal.to_real_prod, ennreal.to_real_of_real (sub_nonneg.2 (h _))]

lemma volume_pi_Ico {a b : ι → ℝ} :
  volume (pi univ (λ i, Ico (a i) (b i))) = ∏ i, ennreal.of_real (b i - a i) :=
(measure_congr measure.univ_pi_Ico_ae_eq_Icc).trans volume_Icc_pi

@[simp] lemma volume_pi_Ico_to_real {a b : ι → ℝ} (h : a ≤ b) :
  (volume (pi univ (λ i, Ico (a i) (b i)))).to_real = ∏ i, (b i - a i) :=
by simp only [volume_pi_Ico, ennreal.to_real_prod, ennreal.to_real_of_real (sub_nonneg.2 (h _))]

@[simp] lemma volume_pi_ball (a : ι → ℝ) {r : ℝ} (hr : 0 < r) :
  volume (metric.ball a r) = ennreal.of_real ((2 * r) ^ fintype.card ι) :=
begin
  simp only [volume_pi_ball a hr, volume_ball, finset.prod_const],
  exact (ennreal.of_real_pow (mul_nonneg zero_le_two hr.le) _).symm
end

@[simp] lemma volume_pi_closed_ball (a : ι → ℝ) {r : ℝ} (hr : 0 ≤ r) :
  volume (metric.closed_ball a r) = ennreal.of_real ((2 * r) ^ fintype.card ι) :=
begin
  simp only [volume_pi_closed_ball a hr, volume_closed_ball, finset.prod_const],
  exact (ennreal.of_real_pow (mul_nonneg zero_le_two hr) _).symm
end

lemma volume_le_diam (s : set ℝ) : volume s ≤ emetric.diam s :=
begin
  by_cases hs : metric.bounded s,
  { rw [real.ediam_eq hs, ← volume_Icc],
    exact volume.mono (real.subset_Icc_Inf_Sup_of_bounded hs) },
  { rw metric.ediam_of_unbounded hs, exact le_top }
end

lemma volume_pi_le_prod_diam (s : set (ι → ℝ)) :
  volume s ≤ ∏ i : ι, emetric.diam (function.eval i '' s) :=
calc volume s ≤ volume (pi univ (λ i, closure (function.eval i '' s))) :
  volume.mono $ subset.trans (subset_pi_eval_image univ s) $ pi_mono $ λ i hi, subset_closure
          ... = ∏ i, volume (closure $ function.eval i '' s) :
  volume_pi_pi _
          ... ≤ ∏ i : ι, emetric.diam (function.eval i '' s) :
  finset.prod_le_prod' $ λ i hi, (volume_le_diam _).trans_eq (emetric.diam_closure _)

lemma volume_pi_le_diam_pow (s : set (ι → ℝ)) :
  volume s ≤ emetric.diam s ^ fintype.card ι :=
calc volume s ≤ ∏ i : ι, emetric.diam (function.eval i '' s) : volume_pi_le_prod_diam s
          ... ≤ ∏ i : ι, (1 : ℝ≥0) * emetric.diam s                      :
  finset.prod_le_prod' $ λ i hi, (lipschitz_with.eval i).ediam_image_le s
          ... = emetric.diam s ^ fintype.card ι              :
  by simp only [ennreal.coe_one, one_mul, finset.prod_const, fintype.card]

/-!
### Images of the Lebesgue measure under translation/multiplication in ℝ
-/

lemma map_volume_add_left (a : ℝ) : measure.map ((+) a) volume = volume :=
eq.symm $ real.measure_ext_Ioo_rat $ λ p q,
  by simp [measure.map_apply (measurable_const_add a) measurable_set_Ioo, sub_sub_sub_cancel_right]

@[simp] lemma volume_preimage_add_left (a : ℝ) (s : set ℝ) : volume (((+) a) ⁻¹' s) = volume s :=
calc volume (((+) a) ⁻¹' s) = measure.map ((+) a) volume s :
  ((homeomorph.add_left a).to_measurable_equiv.map_apply s).symm
... = volume s : by rw map_volume_add_left

lemma map_volume_add_right (a : ℝ) : measure.map (+ a) volume = volume :=
by simpa only [add_comm] using real.map_volume_add_left a

@[simp] lemma volume_preimage_add_right (a : ℝ) (s : set ℝ) : volume ((+ a) ⁻¹' s) = volume s :=
calc volume ((+ a) ⁻¹' s) = measure.map (+ a) volume s :
  ((homeomorph.add_right a).to_measurable_equiv.map_apply s).symm
... = volume s : by rw map_volume_add_right

lemma smul_map_volume_mul_left {a : ℝ} (h : a ≠ 0) :
  ennreal.of_real (|a|) • measure.map ((*) a) volume = volume :=
begin
  refine (real.measure_ext_Ioo_rat $ λ p q, _).symm,
  cases lt_or_gt_of_ne h with h h,
  { simp only [real.volume_Ioo, measure.smul_apply, ← ennreal.of_real_mul (le_of_lt $ neg_pos.2 h),
      measure.map_apply (measurable_const_mul a) measurable_set_Ioo, neg_sub_neg,
      ← neg_mul_eq_neg_mul, preimage_const_mul_Ioo_of_neg _ _ h, abs_of_neg h, mul_sub,
      mul_div_cancel' _ (ne_of_lt h)] },
  { simp only [real.volume_Ioo, measure.smul_apply, ← ennreal.of_real_mul (le_of_lt h),
      measure.map_apply (measurable_const_mul a) measurable_set_Ioo, preimage_const_mul_Ioo _ _ h,
      abs_of_pos h, mul_sub, mul_div_cancel' _ (ne_of_gt h)] }
end

lemma map_volume_mul_left {a : ℝ} (h : a ≠ 0) :
  measure.map ((*) a) volume = ennreal.of_real (|a⁻¹|) • volume :=
by conv_rhs { rw [← real.smul_map_volume_mul_left h, smul_smul,
  ← ennreal.of_real_mul (abs_nonneg _), ← abs_mul, inv_mul_cancel h, abs_one, ennreal.of_real_one,
  one_smul] }

@[simp] lemma volume_preimage_mul_left {a : ℝ} (h : a ≠ 0) (s : set ℝ) :
  volume (((*) a) ⁻¹' s) = ennreal.of_real (abs a⁻¹) * volume s :=
calc volume (((*) a) ⁻¹' s) = measure.map ((*) a) volume s :
  ((homeomorph.mul_left₀ a h).to_measurable_equiv.map_apply s).symm
... = ennreal.of_real (abs a⁻¹) * volume s : by { rw map_volume_mul_left h, refl }

lemma smul_map_volume_mul_right {a : ℝ} (h : a ≠ 0) :
  ennreal.of_real (|a|) • measure.map (* a) volume = volume :=
by simpa only [mul_comm] using real.smul_map_volume_mul_left h

lemma map_volume_mul_right {a : ℝ} (h : a ≠ 0) :
  measure.map (* a) volume = ennreal.of_real (|a⁻¹|) • volume :=
by simpa only [mul_comm] using real.map_volume_mul_left h

@[simp] lemma volume_preimage_mul_right {a : ℝ} (h : a ≠ 0) (s : set ℝ) :
  volume ((* a) ⁻¹' s) = ennreal.of_real (abs a⁻¹) * volume s :=
calc volume ((* a) ⁻¹' s) = measure.map (* a) volume s :
  ((homeomorph.mul_right₀ a h).to_measurable_equiv.map_apply s).symm
... = ennreal.of_real (abs a⁻¹) * volume s : by { rw map_volume_mul_right h, refl }

@[simp] lemma map_volume_neg : measure.map has_neg.neg (volume : measure ℝ) = volume :=
eq.symm $ real.measure_ext_Ioo_rat $ λ p q,
  by simp [show measure.map has_neg.neg volume (Ioo (p : ℝ) q) = _,
    from measure.map_apply measurable_neg measurable_set_Ioo]

/-!
### Images of the Lebesgue measure under translation/linear maps in ℝⁿ
-/

lemma map_volume_pi_add_left (a : ι → ℝ) : measure.map ((+) a) volume = volume :=
begin
  refine (measure.pi_eq (λ s hs, _)).symm,
  have A : has_add.add a ⁻¹' (set.pi univ (λ (i : ι), s i))
    = set.pi univ (λ (i : ι), ((+) (a i)) ⁻¹' (s i)), by { ext, simp },
  rw [measure.map_apply (measurable_const_add a) (measurable_set.univ_pi_fintype hs), A,
      volume_pi_pi],
  simp only [volume_preimage_add_left]
end

@[simp] lemma volume_pi_preimage_add_left (a : ι → ℝ) (s : set (ι → ℝ)) :
  volume (((+) a) ⁻¹' s) = volume s :=
calc volume (((+) a) ⁻¹' s) = measure.map ((+) a) volume s :
  ((homeomorph.add_left a).to_measurable_equiv.map_apply s).symm
... = volume s : by rw map_volume_pi_add_left

open matrix

/-- A diagonal matrix rescales Lebesgue according to its determinant. This is a special case of
`real.map_matrix_volume_pi_eq_smul_volume_pi`, that one should use instead (and whose proof
uses this particular case). -/
lemma smul_map_diagonal_volume_pi [decidable_eq ι] {D : ι → ℝ} (h : det (diagonal D) ≠ 0) :
  ennreal.of_real (abs (det (diagonal D))) • measure.map ((diagonal D).to_lin') volume = volume :=
begin
  refine (measure.pi_eq (λ s hs, _)).symm,
  simp only [det_diagonal, measure.coe_smul, algebra.id.smul_eq_mul, pi.smul_apply],
  rw [measure.map_apply _ (measurable_set.univ_pi_fintype hs)],
  swap, { exact continuous.measurable (linear_map.continuous_on_pi _) },
  have : (matrix.to_lin' (diagonal D)) ⁻¹' (set.pi set.univ (λ (i : ι), s i))
    = set.pi set.univ (λ (i : ι), ((*) (D i)) ⁻¹' (s i)),
  { ext f,
    simp only [linear_map.coe_proj, algebra.id.smul_eq_mul, linear_map.smul_apply, mem_univ_pi,
      mem_preimage, linear_map.pi_apply, diagonal_to_lin'] },
  have B : ∀ i, of_real (abs (D i)) * volume (has_mul.mul (D i) ⁻¹' s i) = volume (s i),
  { assume i,
    have A : D i ≠ 0,
    { simp only [det_diagonal, ne.def] at h,
      exact finset.prod_ne_zero_iff.1 h i (finset.mem_univ i) },
    rw [volume_preimage_mul_left A, ← mul_assoc, ← ennreal.of_real_mul (abs_nonneg _), ← abs_mul,
      mul_inv_cancel A, abs_one, ennreal.of_real_one, one_mul] },
  rw [this, volume_pi_pi, finset.abs_prod,
    ennreal.of_real_prod_of_nonneg (λ i hi, abs_nonneg (D i)), ← finset.prod_mul_distrib],
  simp only [B]
end

/-- A transvection preserves Lebesgue measure. -/
lemma map_transvection_volume_pi [decidable_eq ι] (t : transvection_struct ι ℝ) :
  measure.map (t.to_matrix.to_lin') volume = volume :=
begin
  /- We separate the coordinate along which there is a shearing from the other ones, and apply
  Fubini. Along this coordinate (and when all the other coordinates are fixed), it acts like a
  translation, and therefore preserves Lebesgue. -/
  suffices H : measure_preserving t.to_matrix.to_lin' volume volume, by exact H.2,
  let p : ι → Prop := λ i, i ≠ t.i,
  let α : Type* := {x // p x},
  let β : Type* := {x // ¬ (p x)},
  let g : (α → ℝ) → (β → ℝ) → (β → ℝ) := λ a b, (λ x, t.c * a ⟨t.j, t.hij.symm⟩) + b,
  let F : (α → ℝ) × (β → ℝ) → (α → ℝ) × (β → ℝ) :=
    λ p, (id p.1, g p.1 p.2),
  let e := equiv.pi_equiv_pi_subtype_prod p (λ (i : ι), ℝ),
  have : (t.to_matrix.to_lin' : (ι → ℝ) → (ι → ℝ)) = e.symm ∘ F ∘ e,
  { cases t,
    ext f k,
    simp only [linear_equiv.map_smul, dite_eq_ite, linear_map.id_coe, p, ite_not,
      algebra.id.smul_eq_mul, one_mul, dot_product, std_basis_matrix,
      equiv.pi_equiv_pi_subtype_prod_symm_apply, id.def, transvection,
      pi.add_apply, zero_mul, linear_map.smul_apply, function.comp_app,
      equiv.pi_equiv_pi_subtype_prod_apply, matrix.transvection_struct.to_matrix_mk,
      matrix.mul_vec, linear_equiv.map_add, ite_mul, e, matrix.to_lin'_apply,
      pi.smul_apply, subtype.coe_mk, g, linear_map.add_apply, finset.sum_congr, matrix.to_lin'_one],
    by_cases h : t_i = k,
    { simp only [h, true_and, finset.mem_univ, if_true, eq_self_iff_true, finset.sum_ite_eq,
        one_apply, boole_mul, add_comm], },
    { simp only [h, ne.symm h, add_zero, if_false, finset.sum_const_zero, false_and, mul_zero] } },
  rw this,
  have A : measure_preserving e volume volume :=
  ⟨ measurable_pi_equiv_pi_subtype_prod (λ i, ℝ) _,
    (measure.map_pi_equiv_pi_subtype_prod (λ i, (volume : measure ℝ)) p : _) ⟩,
  have B : measure_preserving F volume volume,
  { have g_meas : measurable (function.uncurry g),
    { have : measurable (λ (c : (α → ℝ)), c ⟨t.j, t.hij.symm⟩) :=
        measurable_pi_apply ⟨t.j, t.hij.symm⟩,
      refine measurable.add (measurable_pi_lambda _ (λ i, measurable.const_mul _ _)) measurable_snd,
      exact this.comp measurable_fst },
    exact measure_preserving.skew_product (measure_preserving.id _) g_meas
      (eventually_of_forall (λ a, map_volume_pi_add_left _)) },
  have C : measure_preserving e.symm volume volume :=
  ⟨ (measurable_pi_equiv_pi_subtype_prod_symm (λ (i : ι), ℝ) p : _),
    (measure.map_pi_equiv_pi_subtype_prod_symm (λ (i : ι), volume) p : _) ⟩,
  exact (C.comp B).comp A,
end

/-- Any invertible matrix rescales Lebesgue measure through the absolute value of its
determinant. -/
lemma map_matrix_volume_pi_eq_smul_volume_pi [decidable_eq ι] {M : matrix ι ι ℝ} (hM : det M ≠ 0) :
  measure.map (M.to_lin') volume = ennreal.of_real (abs (det M)⁻¹) • volume :=
begin
  -- This follows from the cases we have already proved, of diagonal matrices and transvections,
  -- as these matrices generate all invertible matrices.
  apply diagonal_transvection_induction_of_det_ne_zero _ M hM (λ D hD, _) (λ t, _)
    (λ A B hA hB IHA IHB, _),
  { conv_rhs { rw [← smul_map_diagonal_volume_pi hD] },
    rw [smul_smul, ← ennreal.of_real_mul (abs_nonneg _), ← abs_mul, inv_mul_cancel hD, abs_one,
      ennreal.of_real_one, one_smul] },
  { simp only [matrix.transvection_struct.det, ennreal.of_real_one, map_transvection_volume_pi,
      one_smul, _root_.inv_one, abs_one] },
  { rw [to_lin'_mul, det_mul, linear_map.coe_comp, ← measure.map_map, IHB, linear_map.map_smul,
      IHA, smul_smul, ← ennreal.of_real_mul (abs_nonneg _), ← abs_mul, mul_comm, mul_inv₀],
    { apply continuous.measurable,
      apply linear_map.continuous_on_pi },
    { apply continuous.measurable,
      apply linear_map.continuous_on_pi } }
end

/-- Any invertible linear map rescales Lebesgue measure through the absolute value of its
determinant. -/
lemma map_linear_map_volume_pi_eq_smul_volume_pi {f : (ι → ℝ) →ₗ[ℝ] (ι → ℝ)} (hf : f.det ≠ 0) :
  measure.map f volume = ennreal.of_real (abs (f.det)⁻¹) • volume :=
begin
  -- this is deduced from the matrix case
  classical,
  let M := f.to_matrix',
  have A : f.det = det M, by simp only [linear_map.det_to_matrix'],
  have B : f = M.to_lin', by simp only [to_lin'_to_matrix'],
  rw [A, B],
  apply map_matrix_volume_pi_eq_smul_volume_pi,
  rwa A at hf
end

end real

open_locale topological_space

lemma filter.eventually.volume_pos_of_nhds_real {p : ℝ → Prop} {a : ℝ} (h : ∀ᶠ x in 𝓝 a, p x) :
  (0 : ℝ≥0∞) < volume {x | p x} :=
begin
  rcases h.exists_Ioo_subset with ⟨l, u, hx, hs⟩,
  refine lt_of_lt_of_le _ (measure_mono hs),
  simpa [-mem_Ioo] using hx.1.trans hx.2
end

section region_between

open_locale classical

variable {α : Type*}

/-- The region between two real-valued functions on an arbitrary set. -/
def region_between (f g : α → ℝ) (s : set α) : set (α × ℝ) :=
{p : α × ℝ | p.1 ∈ s ∧ p.2 ∈ Ioo (f p.1) (g p.1)}

lemma region_between_subset (f g : α → ℝ) (s : set α) : region_between f g s ⊆ s.prod univ :=
by simpa only [prod_univ, region_between, set.preimage, set_of_subset_set_of] using λ a, and.left

variables [measurable_space α] {μ : measure α} {f g : α → ℝ} {s : set α}

/-- The region between two measurable functions on a measurable set is measurable. -/
lemma measurable_set_region_between
  (hf : measurable f) (hg : measurable g) (hs : measurable_set s) :
  measurable_set (region_between f g s) :=
begin
  dsimp only [region_between, Ioo, mem_set_of_eq, set_of_and],
  refine measurable_set.inter _ ((measurable_set_lt (hf.comp measurable_fst) measurable_snd).inter
    (measurable_set_lt measurable_snd (hg.comp measurable_fst))),
  convert hs.prod measurable_set.univ,
  simp only [and_true, mem_univ],
end

theorem volume_region_between_eq_lintegral'
  (hf : measurable f) (hg : measurable g) (hs : measurable_set s) :
  μ.prod volume (region_between f g s) = ∫⁻ y in s, ennreal.of_real ((g - f) y) ∂μ :=
begin
  rw measure.prod_apply,
  { have h : (λ x, volume {a | x ∈ s ∧ a ∈ Ioo (f x) (g x)})
            = s.indicator (λ x, ennreal.of_real (g x - f x)),
    { funext x,
      rw indicator_apply,
      split_ifs,
      { have hx : {a | x ∈ s ∧ a ∈ Ioo (f x) (g x)} = Ioo (f x) (g x) := by simp [h, Ioo],
        simp only [hx, real.volume_Ioo, sub_zero] },
      { have hx : {a | x ∈ s ∧ a ∈ Ioo (f x) (g x)} = ∅ := by simp [h],
        simp only [hx, measure_empty] } },
    dsimp only [region_between, preimage_set_of_eq],
    rw [h, lintegral_indicator];
    simp only [hs, pi.sub_apply] },
  { exact measurable_set_region_between hf hg hs },
end

/-- The volume of the region between two almost everywhere measurable functions on a measurable set
    can be represented as a Lebesgue integral. -/
theorem volume_region_between_eq_lintegral [sigma_finite μ]
  (hf : ae_measurable f (μ.restrict s)) (hg : ae_measurable g (μ.restrict s))
  (hs : measurable_set s) :
  μ.prod volume (region_between f g s) = ∫⁻ y in s, ennreal.of_real ((g - f) y) ∂μ :=
begin
  have h₁ : (λ y, ennreal.of_real ((g - f) y))
          =ᵐ[μ.restrict s]
              λ y, ennreal.of_real ((ae_measurable.mk g hg - ae_measurable.mk f hf) y) :=
    (hg.ae_eq_mk.sub hf.ae_eq_mk).fun_comp _,
  have h₂ : (μ.restrict s).prod volume (region_between f g s) =
    (μ.restrict s).prod volume (region_between (ae_measurable.mk f hf) (ae_measurable.mk g hg) s),
  { apply measure_congr,
    apply eventually_eq.rfl.inter,
    exact
      ((ae_eq_comp' measurable_fst hf.ae_eq_mk measure.prod_fst_absolutely_continuous).comp₂ _
        eventually_eq.rfl).inter
      (eventually_eq.rfl.comp₂ _
        (ae_eq_comp' measurable_fst hg.ae_eq_mk measure.prod_fst_absolutely_continuous)) },
  rw [lintegral_congr_ae h₁,
      ← volume_region_between_eq_lintegral' hf.measurable_mk hg.measurable_mk hs],
  convert h₂ using 1,
  { rw measure.restrict_prod_eq_prod_univ,
    exact (measure.restrict_eq_self' (hs.prod measurable_set.univ)
      (region_between_subset f g s)).symm, },
  { rw measure.restrict_prod_eq_prod_univ,
    exact (measure.restrict_eq_self' (hs.prod measurable_set.univ)
      (region_between_subset (ae_measurable.mk f hf) (ae_measurable.mk g hg) s)).symm },
end

theorem volume_region_between_eq_integral' [sigma_finite μ]
  (f_int : integrable_on f s μ) (g_int : integrable_on g s μ)
  (hs : measurable_set s) (hfg : f ≤ᵐ[μ.restrict s] g ) :
  μ.prod volume (region_between f g s) = ennreal.of_real (∫ y in s, (g - f) y ∂μ) :=
begin
  have h : g - f =ᵐ[μ.restrict s] (λ x, real.to_nnreal (g x - f x)),
    from hfg.mono (λ x hx, (real.coe_to_nnreal _ $ sub_nonneg.2 hx).symm),
  rw [volume_region_between_eq_lintegral f_int.ae_measurable g_int.ae_measurable hs,
    integral_congr_ae h, lintegral_congr_ae,
    lintegral_coe_eq_integral _ ((integrable_congr h).mp (g_int.sub f_int))],
  simpa only,
end

/-- If two functions are integrable on a measurable set, and one function is less than
    or equal to the other on that set, then the volume of the region
    between the two functions can be represented as an integral. -/
theorem volume_region_between_eq_integral [sigma_finite μ]
  (f_int : integrable_on f s μ) (g_int : integrable_on g s μ)
  (hs : measurable_set s) (hfg : ∀ x ∈ s, f x ≤ g x) :
  μ.prod volume (region_between f g s) = ennreal.of_real (∫ y in s, (g - f) y ∂μ) :=
volume_region_between_eq_integral' f_int g_int hs
  ((ae_restrict_iff' hs).mpr (eventually_of_forall hfg))

end region_between

/-
section vitali

def vitali_aux_h (x : ℝ) (h : x ∈ Icc (0:ℝ) 1) :
  ∃ y ∈ Icc (0:ℝ) 1, ∃ q:ℚ, ↑q = x - y :=
⟨x, h, 0, by simp⟩

def vitali_aux (x : ℝ) (h : x ∈ Icc (0:ℝ) 1) : ℝ :=
classical.some (vitali_aux_h x h)

theorem vitali_aux_mem (x : ℝ) (h : x ∈ Icc (0:ℝ) 1) : vitali_aux x h ∈ Icc (0:ℝ) 1 :=
Exists.fst (classical.some_spec (vitali_aux_h x h):_)

theorem vitali_aux_rel (x : ℝ) (h : x ∈ Icc (0:ℝ) 1) :
 ∃ q:ℚ, ↑q = x - vitali_aux x h :=
Exists.snd (classical.some_spec (vitali_aux_h x h):_)

def vitali : set ℝ := {x | ∃ h, x = vitali_aux x h}

theorem vitali_nonmeasurable : ¬ null_measurable_set measure_space.μ vitali :=
sorry

end vitali
-/


import data.nat.basic
open nat
/- A teacher gives a non-negative integer a to student A,
   and a non-negative integer b to their opponent, student B.
   The teacher then writes two non-negative integers on the
   board -- one is a+b, and the other is not (let's call it c).

   The teacher then asks the students in turn, again and
   again, if they know the other student's number.

   Prove that at some point one of the students will say "yes".
-/

/- definition of the function which keeps track of everything.
   Let's say that a "round" involves the teacher first asking student A
   and then student B if they know their opponent's number.
   The function takes as input the number of rounds d,
   the students' numbers a and b, and the number c on the board
   which is not a+b.

   The output of the function is a pair consisting of two functions
   from the naturals to {true,false}. The first element of the pair
   is what A knows, the second element is what B knows.
-/
def knowledge : ℕ → ℕ → ℕ → ℕ → (ℕ → Prop) × (ℕ → Prop)
-- d,a,b,c to <f,g>.

-- After 0 rounds all they know is that their number plus their opponents number is either c or a+b.
| 0 a b c := (λ bb:ℕ, bb = b ∨ a + bb = c,
              λ aa:ℕ, aa = a ∨ aa + b = c)
-- Assuming both students say "I don't know" on round (d+1),
-- each student knows everything they knew in the previous round, and also that the other student
-- didn't have enough information.
| (succ d) a b c := (λ bb, (knowledge d a b c).1 bb ∧
    ¬ (∀ bbb : ℕ, (knowledge d a b c).2 bbb → bbb = b),λ aa, (knowledge d a b c).2 aa ∧ ¬ (∀ aaa, (knowledge d a b c).1 aaa → aaa = a))

#reduce (knowledge 0 0 7 5).1 5
/-

    -- bb is used to represent the unknown value of b, b is the actual value
    -- the below two lines mean that brown eyed islanders know whether or not anyone left the previous day.
    -- The first line isn't really necessary,
    -- since if any brown eyed islanders left, they would have already deduced that brown eyed islanders should leave.
    ((∀ c:ℕ, (island_rules d i b).1 c → c = b) ↔ (∀ c:ℕ, (island_rules d i bb).1 c → c = bb)) ∧
    ((∀ c:ℕ, (island_rules d i b).2 c → c = b) ↔ (∀ c:ℕ, (island_rules d i bb).2 c → c = bb)),
    -- strictly there may be other things that should be added here, but none of them change the result
    λ bb, (island_rules d i b).2 bb ∧
    ((∀ c:ℕ, (island_rules d i b).1 c → c = b) ↔ (∀ c:ℕ, (island_rules d i bb).1 c → c = bb)) ∧
    ((∀ c:ℕ, (island_rules d i b).2 c → c = b) ↔ (∀ c:ℕ, (island_rules d i bb).2 c → c = bb)))

theorem init_island_1 {d i b bb:ℕ} : (island_rules d i b).2 bb → (b = bb ∨ b - 1 = bb) ∧ bb ≥ 1:=begin
    induction d,simp[island_rules] at *,intros,exact ⟨a,a_1⟩,
    simp [island_rules],intros,exact d_ih a,
end
-/
--theorem Cris_numbers_question : ∀ a b c, c ≠ a + b → ∀ d, (let ⟨Afacts,Bfacts⟩ := knowledge a b c d in Afacts b)

theorem Cris_numbers_question :
  ∀ a b c, c ≠ a + b → ∀ d,
  (let ⟨Afacts,Bfacts⟩ := knowledge a b c d in (Afacts b ∧ Bfacts a ∧ (∃ aa, aa ≠ a ∧ Bfacts aa) ∧ (∃ bb, bb ≠ b ∧ Afacts bb)) → false : Prop) := sorry

--You know, I'm in a modal logic class right now, and usually knowledge is represented by
--a predicate of possible worlds rather than "things I know"


/-
Definition and propositions on Image

from Takesi, Saito "Syugo to Iso" (2009)
-/
import data.set
import data.set.basic

variables {α β: Type*}
variable {X: set α}
variable {Y: set β}

open set

def is_transitive (R: α × α → Prop) : Prop :=
  sorry

def is_reflexive (R: α × α → Prop) : Prop :=
  sorry

def is_symmetry (R: α × α → Prop) : Prop :=
  sorry

def eq_relation (f: α → β) (a: α × α) : Prop :=
  f a.1 = f a.2

/-
Propsition 2.6.1 (1)

The relation Rf by the equivalence of function:
f(x) = f(x') is a equivalence relation.
-/
def is_equiv_relation (R: α × α → Prop): Prop :=
  is_reflexive(R) ∧ is_symmetry(R) ∧ is_transitive(R)

theorem equality_relation_of_f_is_equiv_relation {f: α → β}:
 is_equiv_relation (eq_relation f) := sorry

def graph (R: α × α → Prop) : set(α × α) :=
  {a : α × α | R a}

def diagonal (s : set β) : set (β × β) :=
  {b ∈ (s.prod s) | b.1 = b.2}

variable f': α → β
#check range f'

/--
This function fxf is supposed to use with currying.

eg.
#check fxf f
-> fxf f' : α × α → β × β
-/
def fxf (f: α → β) (a: α × α) : β × β :=
  ⟨f a.1, f a.2⟩

#check fxf f'

--#eval {(f' x.1, f' x.2) ∈ Y.prod Y | x ∈ X.prod X}
/-
Proposition 2.6.1 (2-a)

The graph of the relatio Rf is equivalent with inverse
image of the diagnal set of Y (Δy)
-/
theorem graph_of_eq_relation_f_is_inverse_image_of_diagonal_set
{f : α → β}:
graph (eq_relation f) = preimage (fxf f) (diagonal (range f))
 :=  sorry

def equivalence_class (a: α) (f: α → β) : set α :=
{x:α | f x  = f a}

/-
Proposition 2.6.1 (2.b)

For f: X → Y, the equivalence class a ∈ X on the equivalence
relation of f, is a filber f⁻¹ (f {a}).
-/
theorem equivalence_class_is_fiber {f: α → β} {a:α}:
(equivalence_class a f) = preimage f (image f {a}) :=
sorry


import lib.tactics
import data.nat.basic
import algebra.field
import algebra.group

open nat

@[simp]
lemma zero_lt_succ {n : ℕ} : 0 < n + 1 := by {
  induction n with n ih,
  { exact less_than_or_equal.refl _ },
  { exact less_than_or_equal.step ih } }

@[simp]
lemma nat_div_self {n : ℕ} : (n + 1) / (n + 1) = 1 := begin
  rw [div_def],
  have h : 0 < n + 1 ∧ n + 1 ≤ n + 1 := by simp,
  rw [if_pos h],
  calc
  (n + 1 - (n + 1)) / (n + 1) + 1 = ((n + 1) - (n + 1)) / (n + 1) + 1 : by simp
  ... = 0 / (n + 1) + 1 : by rw [nat.sub_self]
  ... = 1 : by simp
end

lemma self_le_mul {a b : ℕ} : a ≤ (b + 1) * a := begin
  induction b with b ih,
  { simp },
  { have h := by { calc
    (b + 1) * a ≤ (b + 1) * a + a : by exact nat.le_add_right ((b + 1) * a) a
    ... ≤ (b + 1) * a + 1 * a : by simp
    ... ≤ ((b + 1) + 1) * a : by rw [←(nat.right_distrib)]
    ... ≤ (succ b + 1) * a : by simp },
    exact nat.le_trans ih h
  }
end

lemma nat_mul_div_eq (k n : ℕ) : n = n * (k + 1) / (k + 1) := begin
   induction n with n ih,
  { simp },
  { rw [nat.div_def],
     have h₁ : 0 < k + 1 ∧ k + 1 ≤ nat.succ n * (k + 1) := begin
       split,
       { simp },
       { exact self_le_mul }
     end,
     rw [if_pos h₁],
     have h₂ := by calc
     (nat.succ n * (k + 1) - (k + 1)) / (k + 1) + 1
       = ((n + 1) * (k + 1) - (k + 1)) / (k + 1) + 1 : by simp
     ... = ((n * (k + 1) + 1 * (k + 1)) - (k + 1)) / (k + 1) + 1 : by simp [right_distrib]
     ... = ((n * (k + 1) + (k + 1)) - (k + 1)) / (k + 1) + 1 : by simp
     ... = (n * (k + 1)) / (k + 1) + 1 : by rw [nat.add_sub_cancel]
     ... = n + 1 : by rw [←ih],
     simp [h₂] }
end

lemma mul_distrib_of_dvd {a b c : ℕ} : c ∣ a → c ∣ b → a / c + b / c = (a + b) / c := λ ⟨x, h₁⟩ ⟨y, h₂⟩, begin
  rw [h₁, h₂],
  rw [nat.mul_comm c x, nat.mul_comm c y],
  rw [←nat.right_distrib],
  clear _fun_match _fun_match,
  cases c,
  { by simp },
  { rw [←nat_mul_div_eq c x],
     rw [←nat_mul_div_eq c y],
     rw [←nat_mul_div_eq c (x + y)] }
end

lemma dvd_mul (a b : ℕ) : a ∣ a * b := begin
  existsi b, refl
end

lemma suc_odd_even (n : ℕ) : ¬ 2 ∣ n → 2 ∣ n + 1 := begin
  intros h₁,
  by_cases h₂ : 2 ∣ n + 1,
  { exact h₂ },
  { induction n with n ih,
    { exact false.elim (h₁ (by { show 2 ∣ 0, simp })) },
    { have h₃ : ¬ 2 ∣ n := by {
         intro a, cases a with a h, exact h₂ ⟨a + 1, (by { rw [h], ring })⟩ },
       exact false.elim (h₁ (ih h₃ h₁))}}
end

lemma mul_suc_even (n : ℕ) : 2 ∣ n * (n + 1) := begin
  by_cases h₁ : (2 ∣ n),
  { cases h₁ with x h₁,
    rw [h₁],
    simp only [dvd_mul 2 _, nat.mul_assoc] },
  { cases suc_odd_even _ h₁ with x h₁,
     rw [h₁],
     rw [←nat.mul_assoc _ _],
     rw [nat.mul_comm n 2],
     rw [nat.mul_assoc _ _],
     exact dvd_mul 2 _
  }
end


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.equiv.mul_add
import Mathlib.PostPort

universes u u_1 v

namespace Mathlib

/-!
# `ulift` instances for groups and monoids

This file defines instances for group, monoid, semigroup and related structures on `ulift` types.

(Recall `ulift α` is just a "copy" of a type `α` in a higher universe.)

We use `tactic.pi_instance_derive_field`, even though it wasn't intended for this purpose,
which seems to work fine.

We also provide `ulift.mul_equiv : ulift R ≃* R` (and its additive analogue).
-/

namespace ulift

protected instance has_one {α : Type u} [HasOne α] : HasOne (ulift α) := { one := up 1 }

@[simp] theorem one_down {α : Type u} [HasOne α] : down 1 = 1 := rfl

protected instance has_mul {α : Type u} [Mul α] : Mul (ulift α) :=
  { mul := fun (f g : ulift α) => up (down f * down g) }

@[simp] theorem add_down {α : Type u} {x : ulift α} {y : ulift α} [Add α] :
    down (x + y) = down x + down y :=
  rfl

protected instance has_sub {α : Type u} [Sub α] : Sub (ulift α) :=
  { sub := fun (f g : ulift α) => up (down f - down g) }

@[simp] theorem sub_down {α : Type u} {x : ulift α} {y : ulift α} [Sub α] :
    down (x - y) = down x - down y :=
  rfl

protected instance has_inv {α : Type u} [has_inv α] : has_inv (ulift α) :=
  has_inv.mk fun (f : ulift α) => up (down f⁻¹)

@[simp] theorem neg_down {α : Type u} {x : ulift α} [Neg α] : down (-x) = -down x := rfl

protected instance add_semigroup {α : Type u} [add_semigroup α] : add_semigroup (ulift α) :=
  add_semigroup.mk Add.add sorry

/--
The multiplicative equivalence between `ulift α` and `α`.
-/
def mul_equiv {α : Type u} [semigroup α] : ulift α ≃* α := mul_equiv.mk down up sorry sorry sorry

protected instance add_comm_semigroup {α : Type u} [add_comm_semigroup α] :
    add_comm_semigroup (ulift α) :=
  add_comm_semigroup.mk Add.add sorry sorry

protected instance monoid {α : Type u} [monoid α] : monoid (ulift α) :=
  monoid.mk Mul.mul sorry 1 sorry sorry

protected instance comm_monoid {α : Type u} [comm_monoid α] : comm_monoid (ulift α) :=
  comm_monoid.mk Mul.mul sorry 1 sorry sorry sorry

protected instance group {α : Type u} [group α] : group (ulift α) :=
  group.mk Mul.mul sorry 1 sorry sorry has_inv.inv Div.div sorry

protected instance comm_group {α : Type u} [comm_group α] : comm_group (ulift α) :=
  comm_group.mk Mul.mul sorry 1 sorry sorry has_inv.inv Div.div sorry sorry

protected instance left_cancel_semigroup {α : Type u} [left_cancel_semigroup α] :
    left_cancel_semigroup (ulift α) :=
  left_cancel_semigroup.mk Mul.mul sorry sorry

protected instance right_cancel_semigroup {α : Type u} [right_cancel_semigroup α] :
    right_cancel_semigroup (ulift α) :=
  right_cancel_semigroup.mk Mul.mul sorry sorry

end Mathlib


variables P Q R : Prop

/--------------------------------------------------------------------------
``cases``

  ``cases`` is a tactic that breaks up complicated terms.
  If ``hpq`` is a proof of ``P ∧ Q`` or ``P ∨ Q``, then use
  ``cases hpq,``.

English translation:
If ``P ∧ Q`` is true then both ``P`` and ``Q`` are true.
If ``P ∨ Q`` is true then either ``P`` or ``Q`` is true.
--------------------------------------------------------------------------/

theorem ex1 : P ∧ Q → P :=
begin
  intro hpq,
  cases hpq,
  exact hpq_left,
end

theorem ex2 : P ∨ P → P :=
begin
  intro hpp,
  cases hpp,
  exact hpp,
  exact hpp,
end

/--------------------------------------------------------------------------
``split``

  If the current target is ``P ∧ Q`` then use
  ``split,``.

English translation:
To prove ``P ∧ Q`` we need to prove ``P`` and ``Q`` separately.
--------------------------------------------------------------------------/

theorem ex3 (hp : P) (hq : Q) : P ∧ Q :=
begin
  split,
  exact hp,
  exact hq,
end

/--------------------------------------------------------------------------
``left``/``right``

  If the current target is ``P ∨ Q``, then use
  either ``left,`` or ``right,`` (choose wisely).

English translation:
To prove ``P ∨ Q`` we need to prove either ``P`` (left) or ``Q`` (right).
--------------------------------------------------------------------------/

theorem ex4 : P → (P ∨ Q) :=
begin
  intro hp,
  left,
  exact hp,
end

/--------------------------------------------------------------------------
Delete the ``sorry,`` below and replace them with valid proofs.
Don't forget the ``,`` at the end of each tactic.
--------------------------------------------------------------------------/

theorem comm_and : P ∧ Q → Q ∧ P :=
begin
  sorry,
end

-- Be careful: the order of tactics matters, just like in math!
theorem comm_or : P ∨ Q → Q ∨ P :=
begin
  sorry,
end

theorem currying : (P ∧ Q → R) → (P → (Q → R)) :=
begin
  sorry,
end

theorem or_implies : ((P ∨ Q) → R) → (P → R) ∧ (Q → R) :=
begin
  sorry,
end

theorem or_implies_converse : (P → R) ∧ (Q → R) → ((P ∨ Q) → R):=
begin
  sorry,
end

-- you can also use ``apply`` for a sequence of implications ``P → Q → R``
-- if the target is ``R``.
theorem uncurrying : (P → (Q → R)) → (P ∧ Q → R) :=
begin
  sorry,
end


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

import ring_theory.polynomial.cyclotomic.basic
import tactic.by_contra
import topology.algebra.polynomial
import number_theory.padics.padic_val
import analysis.complex.arg

/-!
# Evaluating cyclotomic polynomials
This file states some results about evaluating cyclotomic polynomials in various different ways.
## Main definitions
* `polynomial.eval(₂)_one_cyclotomic_prime(_pow)`: `eval 1 (cyclotomic p^k R) = p`.
* `polynomial.eval_one_cyclotomic_not_prime_pow`: Otherwise, `eval 1 (cyclotomic n R) = 1`.
* `polynomial.cyclotomic_pos` : `∀ x, 0 < eval x (cyclotomic n R)` if `2 < n`.
-/

namespace polynomial

open finset nat
open_locale big_operators

@[simp] lemma eval_one_cyclotomic_prime {R : Type*} [comm_ring R] {p : ℕ} [hn : fact p.prime] :
  eval 1 (cyclotomic p R) = p :=
by simp only [cyclotomic_prime, eval_X, one_pow, finset.sum_const, eval_pow,
              eval_finset_sum, finset.card_range, smul_one_eq_coe]

@[simp] lemma eval₂_one_cyclotomic_prime {R S : Type*} [comm_ring R] [semiring S] (f : R →+* S)
  {p : ℕ} [fact p.prime] : eval₂ f 1 (cyclotomic p R) = p :=
by simp

@[simp] lemma eval_one_cyclotomic_prime_pow {R : Type*} [comm_ring R] {p : ℕ} (k : ℕ)
  [hn : fact p.prime] : eval 1 (cyclotomic (p ^ (k + 1)) R) = p :=
by simp only [cyclotomic_prime_pow_eq_geom_sum hn.out, eval_X, one_pow, finset.sum_const,
              eval_pow, eval_finset_sum, finset.card_range, smul_one_eq_coe]

@[simp] lemma eval₂_one_cyclotomic_prime_pow {R S : Type*} [comm_ring R] [semiring S] (f : R →+* S)
  {p : ℕ} (k : ℕ) [fact p.prime] : eval₂ f 1 (cyclotomic (p ^ (k + 1)) R) = p :=
by simp

private lemma cyclotomic_neg_one_pos {n : ℕ} (hn : 2 < n) {R} [linear_ordered_comm_ring R] :
  0 < eval (-1 : R) (cyclotomic n R) :=
begin
  haveI := ne_zero.of_gt hn,
  rw [←map_cyclotomic_int, ←int.cast_one, ←int.cast_neg, eval_int_cast_map,
      int.coe_cast_ring_hom, int.cast_pos],
  suffices : 0 < eval ↑(-1 : ℤ) (cyclotomic n ℝ),
  { rw [←map_cyclotomic_int n ℝ, eval_int_cast_map, int.coe_cast_ring_hom] at this,
    exact_mod_cast this },
  simp only [int.cast_one, int.cast_neg],
  have h0 := cyclotomic_coeff_zero ℝ hn.le,
  rw coeff_zero_eq_eval_zero at h0,
  by_contra' hx,
  have := intermediate_value_univ (-1) 0 (cyclotomic n ℝ).continuous,
  obtain ⟨y, hy : is_root _ y⟩ := this (show (0 : ℝ) ∈ set.Icc _ _, by simpa [h0] using hx),
  rw is_root_cyclotomic_iff at hy,
  rw hy.eq_order_of at hn,
  exact hn.not_le linear_ordered_ring.order_of_le_two,
end

lemma cyclotomic_pos {n : ℕ} (hn : 2 < n) {R} [linear_ordered_comm_ring R] (x : R) :
  0 < eval x (cyclotomic n R) :=
begin
  induction n using nat.strong_induction_on with n ih,
  have hn'  : 0 < n := pos_of_gt hn,
  have hn'' : 1 < n := one_lt_two.trans hn,
  dsimp at ih,
  have := prod_cyclotomic_eq_geom_sum hn' R,
  apply_fun eval x at this,
  rw [← cons_self_proper_divisors hn'.ne', finset.erase_cons_of_ne _ hn''.ne',
      finset.prod_cons, eval_mul, eval_geom_sum] at this,
  rcases lt_trichotomy 0 (∑ i in finset.range n, x ^ i) with h | h | h,
  { apply pos_of_mul_pos_left,
    { rwa this },
    rw eval_prod,
    refine finset.prod_nonneg (λ i hi, _),
    simp only [finset.mem_erase, mem_proper_divisors] at hi,
    rw geom_sum_pos_iff hn'.ne' at h,
    cases h with hk hx,
    { refine (ih _ hi.2.2 (nat.two_lt_of_ne _ hi.1 _)).le; rintro rfl,
      { exact hn'.ne' (zero_dvd_iff.mp hi.2.1) },
      { exact even_iff_not_odd.mp (even_iff_two_dvd.mpr hi.2.1) hk } },
    { rcases eq_or_ne i 2 with rfl | hk,
      { simpa only [eval_X, eval_one, cyclotomic_two, eval_add] using hx.le },
      refine (ih _ hi.2.2 (nat.two_lt_of_ne _ hi.1 hk)).le,
      rintro rfl,
      exact (hn'.ne' $ zero_dvd_iff.mp hi.2.1) } },
  { rw [eq_comm, geom_sum_eq_zero_iff_neg_one hn'.ne'] at h,
    exact h.1.symm ▸ cyclotomic_neg_one_pos hn },
  { apply pos_of_mul_neg_left,
    { rwa this },
    rw geom_sum_neg_iff hn'.ne' at h,
    have h2 : 2 ∈ n.proper_divisors.erase 1,
    { rw [finset.mem_erase, mem_proper_divisors],
      exact ⟨dec_trivial, even_iff_two_dvd.mp h.1, hn⟩ },
    rw [eval_prod, ← finset.prod_erase_mul _ _ h2],
    apply mul_nonpos_of_nonneg_of_nonpos,
    { refine finset.prod_nonneg (λ i hi, le_of_lt _),
      simp only [finset.mem_erase, mem_proper_divisors] at hi,
      refine ih _ hi.2.2.2 (nat.two_lt_of_ne _ hi.2.1 hi.1),
      rintro rfl,
      rw zero_dvd_iff at hi,
      exact hn'.ne' hi.2.2.1 },
    { simpa only [eval_X, eval_one, cyclotomic_two, eval_add] using h.right.le } }
end

lemma cyclotomic_pos_and_nonneg (n : ℕ) {R} [linear_ordered_comm_ring R] (x : R) :
  (1 < x → 0 < eval x (cyclotomic n R)) ∧ (1 ≤ x → 0 ≤ eval x (cyclotomic n R)) :=
begin
  rcases n with _ | _ | _ | n;
  simp only [cyclotomic_zero, cyclotomic_one, cyclotomic_two, succ_eq_add_one,
    eval_X, eval_one, eval_add, eval_sub, sub_nonneg, sub_pos,
    zero_lt_one, zero_le_one, implies_true_iff, imp_self, and_self],
  { split; intro; linarith, },
  { have : 2 < n + 3 := dec_trivial,
    split; intro; [skip, apply le_of_lt]; apply cyclotomic_pos this, },
end

/-- Cyclotomic polynomials are always positive on inputs larger than one.
Similar to `cyclotomic_pos` but with the condition on the input rather than index of the
cyclotomic polynomial. -/
lemma cyclotomic_pos' (n : ℕ) {R} [linear_ordered_comm_ring R] {x : R} (hx : 1 < x) :
  0 < eval x (cyclotomic n R) :=
(cyclotomic_pos_and_nonneg n x).1 hx

/-- Cyclotomic polynomials are always nonnegative on inputs one or more. -/
lemma cyclotomic_nonneg (n : ℕ) {R} [linear_ordered_comm_ring R] {x : R} (hx : 1 ≤ x) :
  0 ≤ eval x (cyclotomic n R) :=
(cyclotomic_pos_and_nonneg n x).2 hx

lemma eval_one_cyclotomic_not_prime_pow {R : Type*} [ring R] {n : ℕ}
  (h : ∀ {p : ℕ}, p.prime → ∀ k : ℕ, p ^ k ≠ n) : eval 1 (cyclotomic n R) = 1 :=
begin
  rcases n.eq_zero_or_pos with rfl | hn',
  { simp },
  have hn : 1 < n := one_lt_iff_ne_zero_and_ne_one.mpr ⟨hn'.ne', (h nat.prime_two 0).symm⟩,
  rsuffices (h | h) : eval 1 (cyclotomic n ℤ) = 1 ∨ eval 1 (cyclotomic n ℤ) = -1,
  { have := eval_int_cast_map (int.cast_ring_hom R) (cyclotomic n ℤ) 1,
    simpa only [map_cyclotomic, int.cast_one, h, eq_int_cast] using this },
  { exfalso,
    linarith [cyclotomic_nonneg n (le_refl (1 : ℤ))] },
  rw [←int.nat_abs_eq_nat_abs_iff, int.nat_abs_one, nat.eq_one_iff_not_exists_prime_dvd],
  intros p hp hpe,
  haveI := fact.mk hp,

  have hpn : p ∣ n,
  { apply hpe.trans,
    nth_rewrite 1 ←int.nat_abs_of_nat n,
    rw [int.nat_abs_dvd_iff_dvd, ←one_geom_sum, ←eval_geom_sum, ←prod_cyclotomic_eq_geom_sum hn'],
    apply eval_dvd,
    apply finset.dvd_prod_of_mem,
    simp [hn'.ne', hn.ne'] },

  have := prod_cyclotomic_eq_geom_sum hn' ℤ,
  apply_fun eval 1 at this,
  rw [eval_geom_sum, one_geom_sum, eval_prod, eq_comm, ←finset.prod_sdiff $
        @range_pow_padic_val_nat_subset_divisors' p _ _, finset.prod_image] at this,
  simp_rw [eval_one_cyclotomic_prime_pow, finset.prod_const, finset.card_range, mul_comm] at this,
  rw [←finset.prod_sdiff $ show {n} ⊆ _, from _] at this,
  any_goals {apply_instance},
  swap,
  { simp only [singleton_subset_iff, mem_sdiff, mem_erase, ne.def, mem_divisors, dvd_refl,
      true_and, mem_image, mem_range, exists_prop, not_exists, not_and],
    exact ⟨⟨hn.ne', hn'.ne'⟩, λ t _, h hp _⟩ },
  rw [←int.nat_abs_of_nat p, int.nat_abs_dvd_iff_dvd] at hpe,
  obtain ⟨t, ht⟩ := hpe,
  rw [finset.prod_singleton, ht, mul_left_comm, mul_comm, ←mul_assoc, mul_assoc] at this,
  have : (p ^ (padic_val_nat p n) * p : ℤ) ∣ n := ⟨_, this⟩,
  simp only [←pow_succ', ←int.nat_abs_dvd_iff_dvd, int.nat_abs_of_nat, int.nat_abs_pow] at this,
  exact pow_succ_padic_val_nat_not_dvd hn'.ne' this,
  { rintro x - y - hxy,
    apply nat.succ_injective,
    exact nat.pow_right_injective hp.two_le hxy }
end

lemma sub_one_pow_totient_lt_cyclotomic_eval {n : ℕ} {q : ℝ} (hn' : 2 ≤ n) (hq' : 1 < q) :
  (q - 1) ^ totient n < (cyclotomic n ℝ).eval q :=
begin
  have hn : 0 < n := pos_of_gt hn',
  have hq := zero_lt_one.trans hq',
  have hfor : ∀ ζ' ∈ primitive_roots n ℂ, q - 1 ≤ ‖↑q - ζ'‖,
  { intros ζ' hζ',
    rw mem_primitive_roots hn at hζ',
    convert norm_sub_norm_le (↑q) ζ',
    { rw [complex.norm_real, real.norm_of_nonneg hq.le], },
    { rw [hζ'.norm'_eq_one hn.ne'] } },
  let ζ := complex.exp (2 * ↑real.pi * complex.I / ↑n),
  have hζ : is_primitive_root ζ n := complex.is_primitive_root_exp n hn.ne',
  have hex : ∃ ζ' ∈ primitive_roots n ℂ, q - 1 < ‖↑q - ζ'‖,
  { refine ⟨ζ, (mem_primitive_roots hn).mpr hζ, _⟩,
    suffices : ¬ same_ray ℝ (q : ℂ) ζ,
    { convert lt_norm_sub_of_not_same_ray this;
      simp only [hζ.norm'_eq_one hn.ne', real.norm_of_nonneg hq.le, complex.norm_real] },
    rw complex.same_ray_iff,
    push_neg,
    refine ⟨by exact_mod_cast hq.ne', hζ.ne_zero hn.ne', _⟩,
    rw [complex.arg_of_real_of_nonneg hq.le, ne.def, eq_comm, hζ.arg_eq_zero_iff hn.ne'],
    clear_value ζ,
    rintro rfl,
    linarith [hζ.unique is_primitive_root.one] },
  have : ¬eval ↑q (cyclotomic n ℂ) = 0,
  { erw cyclotomic.eval_apply q n (algebra_map ℝ ℂ),
    simpa only [complex.coe_algebra_map, complex.of_real_eq_zero]
                using (cyclotomic_pos' n hq').ne' },
  suffices : (units.mk0 (real.to_nnreal (q - 1)) (by simp [hq'])) ^ totient n
              < units.mk0 (‖(cyclotomic n ℂ).eval q‖₊) (by simp [this]),
  { simp only [←units.coe_lt_coe, units.coe_pow, units.coe_mk0, ← nnreal.coe_lt_coe, hq'.le,
               real.to_nnreal_lt_to_nnreal_iff_of_nonneg, coe_nnnorm, complex.norm_eq_abs,
               nnreal.coe_pow, real.coe_to_nnreal', max_eq_left, sub_nonneg] at this,
    convert this,
    erw [(cyclotomic.eval_apply q n (algebra_map ℝ ℂ)), eq_comm],
    simp only [cyclotomic_nonneg n hq'.le, complex.coe_algebra_map,
               complex.abs_of_real, abs_eq_self], },
  simp only [cyclotomic_eq_prod_X_sub_primitive_roots hζ, eval_prod, eval_C,
             eval_X, eval_sub, nnnorm_prod, units.mk0_prod],
  convert finset.prod_lt_prod' _ _,
  swap, { exact λ _, units.mk0 (real.to_nnreal (q - 1)) (by simp [hq']) },
  { simp only [complex.card_primitive_roots, prod_const, card_attach] },
  { simp only [subtype.coe_mk, finset.mem_attach, forall_true_left, subtype.forall,
      ←units.coe_le_coe, ← nnreal.coe_le_coe, complex.abs.nonneg, hq'.le, units.coe_mk0,
      real.coe_to_nnreal', coe_nnnorm, complex.norm_eq_abs, max_le_iff, tsub_le_iff_right],
    intros x hx,
    simpa only [and_true, tsub_le_iff_right] using hfor x hx, },
  { simp only [subtype.coe_mk, finset.mem_attach, exists_true_left, subtype.exists,
      ← nnreal.coe_lt_coe, ← units.coe_lt_coe, units.coe_mk0 _, coe_nnnorm],
    simpa only [hq'.le, real.coe_to_nnreal', max_eq_left, sub_nonneg] using hex },
end

lemma sub_one_pow_totient_le_cyclotomic_eval {q : ℝ} (hq' : 1 < q) :
  ∀ n, (q - 1) ^ totient n ≤ (cyclotomic n ℝ).eval q
| 0 := by simp only [totient_zero, pow_zero, cyclotomic_zero, eval_one]
| 1 := by simp only [totient_one, pow_one, cyclotomic_one, eval_sub, eval_X, eval_one]
| (n + 2) := (sub_one_pow_totient_lt_cyclotomic_eval dec_trivial hq').le

lemma cyclotomic_eval_lt_add_one_pow_totient {n : ℕ} {q : ℝ} (hn' : 3 ≤ n) (hq' : 1 < q) :
  (cyclotomic n ℝ).eval q < (q + 1) ^ totient n :=
begin
  have hn : 0 < n := pos_of_gt hn',
  have hq := zero_lt_one.trans hq',
  have hfor : ∀ ζ' ∈ primitive_roots n ℂ, ‖↑q - ζ'‖ ≤ q + 1,
  { intros ζ' hζ',
    rw mem_primitive_roots hn at hζ',
    convert norm_sub_le (↑q) ζ',
    { rw [complex.norm_real, real.norm_of_nonneg (zero_le_one.trans_lt hq').le], },
    { rw [hζ'.norm'_eq_one hn.ne'] }, },
  let ζ := complex.exp (2 * ↑real.pi * complex.I / ↑n),
  have hζ : is_primitive_root ζ n := complex.is_primitive_root_exp n hn.ne',
  have hex : ∃ ζ' ∈ primitive_roots n ℂ, ‖↑q - ζ'‖ < q + 1,
  { refine ⟨ζ, (mem_primitive_roots hn).mpr hζ, _⟩,
    suffices : ¬ same_ray ℝ (q : ℂ) (-ζ),
    { convert norm_add_lt_of_not_same_ray this;
      simp [real.norm_of_nonneg hq.le, hζ.norm'_eq_one hn.ne', -complex.norm_eq_abs] },
    rw complex.same_ray_iff,
    push_neg,
    refine ⟨by exact_mod_cast hq.ne', neg_ne_zero.mpr $ hζ.ne_zero hn.ne', _⟩,
    rw [complex.arg_of_real_of_nonneg hq.le, ne.def, eq_comm],
    intro h,
    rw [complex.arg_eq_zero_iff, complex.neg_re, neg_nonneg, complex.neg_im, neg_eq_zero] at h,
    have hζ₀ : ζ ≠ 0,
    { clear_value ζ,
      rintro rfl,
      exact hn.ne' (hζ.unique is_primitive_root.zero) },
    have : ζ.re < 0 ∧ ζ.im = 0 := ⟨h.1.lt_of_ne _, h.2⟩,
    rw [←complex.arg_eq_pi_iff, hζ.arg_eq_pi_iff hn.ne'] at this,
    rw this at hζ,
    linarith [hζ.unique $ is_primitive_root.neg_one 0 two_ne_zero.symm],
    { contrapose! hζ₀,
      ext; simp [hζ₀, h.2] } },
  have : ¬eval ↑q (cyclotomic n ℂ) = 0,
  { erw cyclotomic.eval_apply q n (algebra_map ℝ ℂ),
    simp only [complex.coe_algebra_map, complex.of_real_eq_zero],
    exact (cyclotomic_pos' n hq').ne.symm, },
  suffices : units.mk0 (‖(cyclotomic n ℂ).eval q‖₊) (by simp [this])
           < (units.mk0 (real.to_nnreal (q + 1)) (by simp; linarith)) ^ totient n,
  { simp only [←units.coe_lt_coe, units.coe_pow, units.coe_mk0, ← nnreal.coe_lt_coe, hq'.le,
               real.to_nnreal_lt_to_nnreal_iff_of_nonneg, coe_nnnorm, complex.norm_eq_abs,
               nnreal.coe_pow, real.coe_to_nnreal', max_eq_left, sub_nonneg] at this,
    convert this,
    { erw [(cyclotomic.eval_apply q n (algebra_map ℝ ℂ)), eq_comm],
      simp [cyclotomic_nonneg n hq'.le] },
    rw [eq_comm, max_eq_left_iff],
    linarith },
  simp only [cyclotomic_eq_prod_X_sub_primitive_roots hζ, eval_prod, eval_C,
             eval_X, eval_sub, nnnorm_prod, units.mk0_prod],
  convert finset.prod_lt_prod' _ _,
  swap, { exact λ _, units.mk0 (real.to_nnreal (q + 1)) (by simp; linarith only [hq']) },
  { simp [complex.card_primitive_roots], },
  { simp only [subtype.coe_mk, finset.mem_attach, forall_true_left, subtype.forall,
      ←units.coe_le_coe, ← nnreal.coe_le_coe, complex.abs.nonneg, hq'.le, units.coe_mk0,
      real.coe_to_nnreal, coe_nnnorm, complex.norm_eq_abs, max_le_iff],
    intros x hx,
    have : complex.abs _ ≤ _ := hfor x hx,
    simp [this], },
  { simp only [subtype.coe_mk, finset.mem_attach, exists_true_left, subtype.exists,
      ← nnreal.coe_lt_coe, ← units.coe_lt_coe, units.coe_mk0 _, coe_nnnorm],
    obtain ⟨ζ, hζ, hhζ : complex.abs _ < _⟩ := hex,
    exact ⟨ζ, hζ, by simp [hhζ]⟩ },
end

lemma cyclotomic_eval_le_add_one_pow_totient {q : ℝ} (hq' : 1 < q) :
  ∀ n, (cyclotomic n ℝ).eval q ≤ (q + 1) ^ totient n
| 0 := by simp
| 1 := by simp [add_assoc, add_nonneg, zero_le_one]
| 2 := by simp
| (n + 3) := (cyclotomic_eval_lt_add_one_pow_totient dec_trivial hq').le

lemma sub_one_pow_totient_lt_nat_abs_cyclotomic_eval {n : ℕ} {q : ℕ} (hn' : 1 < n) (hq : q ≠ 1) :
  (q - 1) ^ totient n < ((cyclotomic n ℤ).eval ↑q).nat_abs :=
begin
  rcases hq.lt_or_lt.imp_left nat.lt_one_iff.mp with rfl | hq',
  { rw [zero_tsub, zero_pow (nat.totient_pos (pos_of_gt hn')), pos_iff_ne_zero, int.nat_abs_ne_zero,
      nat.cast_zero, ← coeff_zero_eq_eval_zero, cyclotomic_coeff_zero _ hn'],
    exact one_ne_zero },
  rw [← @nat.cast_lt ℝ, nat.cast_pow, nat.cast_sub hq'.le, nat.cast_one, int.cast_nat_abs],
  refine (sub_one_pow_totient_lt_cyclotomic_eval hn' (nat.one_lt_cast.2 hq')).trans_le _,
  exact (cyclotomic.eval_apply (q : ℤ) n (algebra_map ℤ ℝ)).trans_le (le_abs_self _)
end

lemma sub_one_lt_nat_abs_cyclotomic_eval {n : ℕ} {q : ℕ} (hn' : 1 < n) (hq : q ≠ 1) :
  q - 1 < ((cyclotomic n ℤ).eval ↑q).nat_abs :=
calc q - 1 ≤ (q - 1) ^ totient n : nat.le_self_pow (nat.totient_pos $ pos_of_gt hn').ne' _
... < ((cyclotomic n ℤ).eval ↑q).nat_abs : sub_one_pow_totient_lt_nat_abs_cyclotomic_eval hn' hq

end polynomial


/-
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 algebra.order.group.order_iso
import algebra.order.monoid.order_dual
import data.set.pointwise.basic
import order.bounds.order_iso
import order.conditionally_complete_lattice.basic

/-!
# Upper/lower bounds in ordered monoids and groups

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

In this file we prove a few facts like “`-s` is bounded above iff `s` is bounded below”
(`bdd_above_neg`).
-/

open function set
open_locale pointwise

section inv_neg

variables {G : Type*} [group G] [preorder G] [covariant_class G G (*) (≤)]
  [covariant_class G G (swap (*)) (≤)] {s : set G} {a : G}

@[simp, to_additive]
lemma bdd_above_inv : bdd_above s⁻¹ ↔ bdd_below s := (order_iso.inv G).bdd_above_preimage

@[simp, to_additive]
lemma bdd_below_inv : bdd_below s⁻¹ ↔ bdd_above s := (order_iso.inv G).bdd_below_preimage

@[to_additive]
lemma bdd_above.inv (h : bdd_above s) : bdd_below s⁻¹ := bdd_below_inv.2 h

@[to_additive]
lemma bdd_below.inv (h : bdd_below s) : bdd_above s⁻¹ := bdd_above_inv.2 h

@[simp, to_additive]
lemma is_lub_inv : is_lub s⁻¹ a ↔ is_glb s a⁻¹ := (order_iso.inv G).is_lub_preimage

@[to_additive]
lemma is_lub_inv' : is_lub s⁻¹ a⁻¹ ↔ is_glb s a := (order_iso.inv G).is_lub_preimage'

@[to_additive]
lemma is_glb.inv (h : is_glb s a) : is_lub s⁻¹ a⁻¹ := is_lub_inv'.2 h

@[simp, to_additive]
lemma is_glb_inv : is_glb s⁻¹ a ↔ is_lub s a⁻¹ := (order_iso.inv G).is_glb_preimage

@[to_additive]
lemma is_glb_inv' : is_glb s⁻¹ a⁻¹ ↔ is_lub s a := (order_iso.inv G).is_glb_preimage'

@[to_additive]
lemma is_lub.inv (h : is_lub s a) : is_glb s⁻¹ a⁻¹ := is_glb_inv'.2 h

end inv_neg

section mul_add

variables {M : Type*} [has_mul M] [preorder M] [covariant_class M M (*) (≤)]
  [covariant_class M M (swap (*)) (≤)]

@[to_additive] lemma mul_mem_upper_bounds_mul {s t : set M} {a b : M} (ha : a ∈ upper_bounds s)
  (hb : b ∈ upper_bounds t) :
  a * b ∈ upper_bounds (s * t) :=
forall_image2_iff.2 $ λ x hx y hy, mul_le_mul' (ha hx) (hb hy)

@[to_additive] lemma subset_upper_bounds_mul (s t : set M) :
  upper_bounds s * upper_bounds t ⊆ upper_bounds (s * t) :=
image2_subset_iff.2 $ λ x hx y hy, mul_mem_upper_bounds_mul hx hy

@[to_additive] lemma mul_mem_lower_bounds_mul {s t : set M} {a b : M} (ha : a ∈ lower_bounds s)
  (hb : b ∈ lower_bounds t) : a * b ∈ lower_bounds (s * t) :=
@mul_mem_upper_bounds_mul Mᵒᵈ _ _ _ _ _ _ _ _ ha hb

@[to_additive] lemma subset_lower_bounds_mul (s t : set M) :
  lower_bounds s * lower_bounds t ⊆ lower_bounds (s * t) :=
@subset_upper_bounds_mul Mᵒᵈ _ _ _ _ _ _

@[to_additive] lemma bdd_above.mul {s t : set M} (hs : bdd_above s) (ht : bdd_above t) :
  bdd_above (s * t) :=
(hs.mul ht).mono (subset_upper_bounds_mul s t)

@[to_additive] lemma bdd_below.mul {s t : set M} (hs : bdd_below s) (ht : bdd_below t) :
  bdd_below (s * t) :=
(hs.mul ht).mono (subset_lower_bounds_mul s t)

end mul_add

section conditionally_complete_lattice

section right

variables {ι G : Type*} [group G] [conditionally_complete_lattice G]
  [covariant_class G G (function.swap (*)) (≤)] [nonempty ι] {f : ι → G}

@[to_additive] lemma csupr_mul (hf : bdd_above (set.range f)) (a : G) :
  (⨆ i, f i) * a = ⨆ i, f i * a :=
(order_iso.mul_right a).map_csupr hf

@[to_additive] lemma csupr_div (hf : bdd_above (set.range f)) (a : G) :
  (⨆ i, f i) / a = ⨆ i, f i / a :=
by simp only [div_eq_mul_inv, csupr_mul hf]

end right

section left

variables {ι G : Type*} [group G] [conditionally_complete_lattice G]
  [covariant_class G G (*) (≤)] [nonempty ι] {f : ι → G}

@[to_additive] lemma mul_csupr (hf : bdd_above (set.range f)) (a : G) :
  a * (⨆ i, f i) = ⨆ i, a * f i :=
(order_iso.mul_left a).map_csupr hf

end left

end conditionally_complete_lattice


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

import field_theory.primitive_element
import linear_algebra.determinant
import linear_algebra.matrix.charpoly.coeff
import linear_algebra.matrix.to_linear_equiv
import field_theory.is_alg_closed.algebraic_closure

/-!
# Norm for (finite) ring extensions

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

## Implementation notes

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

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

See also `algebra.trace`, which is defined similarly as the trace of
`algebra.left_mul_matrix`.

## References

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

-/

universes u v w

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

open finite_dimensional
open linear_map
open matrix polynomial

open_locale big_operators
open_locale matrix

namespace algebra

variables (R)

/-- The norm of an element `s` of an `R`-algebra is the determinant of `(*) s`. -/
noncomputable def norm : S →* R :=
linear_map.det.comp (lmul R S).to_ring_hom.to_monoid_hom

lemma norm_apply (x : S) : norm R x = linear_map.det (lmul R S x) := rfl

lemma norm_eq_one_of_not_exists_basis
  (h : ¬ ∃ (s : finset S), nonempty (basis s R S)) (x : S) : norm R x = 1 :=
by { rw [norm_apply, linear_map.det], split_ifs with h, refl }

variables {R}

-- Can't be a `simp` lemma because it depends on a choice of basis
lemma norm_eq_matrix_det [decidable_eq ι] (b : basis ι R S) (s : S) :
  norm R s = matrix.det (algebra.left_mul_matrix b s) :=
by rw [norm_apply, ← linear_map.det_to_matrix b, to_matrix_lmul_eq]

/-- If `x` is in the base field `K`, then the norm is `x ^ [L : K]`. -/
lemma norm_algebra_map_of_basis (b : basis ι R S) (x : R) :
  norm R (algebra_map R S x) = x ^ fintype.card ι :=
begin
  haveI := classical.dec_eq ι,
  rw [norm_apply, ← det_to_matrix b, lmul_algebra_map],
  convert @det_diagonal _ _ _ _ _ (λ (i : ι), x),
  { ext i j, rw [to_matrix_lsmul, matrix.diagonal] },
  { rw [finset.prod_const, finset.card_univ] }
end

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

(If `L` is not finite-dimensional over `K`, then `norm = 1 = x ^ 0 = x ^ (finrank L K)`.)
-/
@[simp]
lemma norm_algebra_map (x : K) : norm K (algebra_map K L x) = x ^ finrank K L :=
begin
  by_cases H : ∃ (s : finset L), nonempty (basis s K L),
  { rw [norm_algebra_map_of_basis H.some_spec.some, finrank_eq_card_basis H.some_spec.some] },
  { rw [norm_eq_one_of_not_exists_basis K H, finrank_eq_zero_of_not_exists_basis, pow_zero],
    rintros ⟨s, ⟨b⟩⟩,
    exact H ⟨s, ⟨b⟩⟩ },
end

section eq_prod_roots

/-- Given `pb : power_basis K S`, then the norm of `pb.gen` is
`(-1) ^ pb.dim * coeff (minpoly K pb.gen) 0`. -/
lemma power_basis.norm_gen_eq_coeff_zero_minpoly [algebra K S] (pb : power_basis K S) :
  norm K pb.gen = (-1) ^ pb.dim * coeff (minpoly K pb.gen) 0 :=
begin
  rw [norm_eq_matrix_det pb.basis, det_eq_sign_charpoly_coeff, charpoly_left_mul_matrix,
    fintype.card_fin]
end

/-- Given `pb : power_basis K S`, then the norm of `pb.gen` is
`((minpoly K pb.gen).map (algebra_map K F)).roots.prod`. -/
lemma power_basis.norm_gen_eq_prod_roots [algebra K S] (pb : power_basis K S)
  (hf : (minpoly K pb.gen).splits (algebra_map K F)) :
  algebra_map K F (norm K pb.gen) =
    ((minpoly K pb.gen).map (algebra_map K F)).roots.prod :=
begin
  rw [power_basis.norm_gen_eq_coeff_zero_minpoly, ← pb.nat_degree_minpoly, ring_hom.map_mul,
    ← coeff_map, prod_roots_eq_coeff_zero_of_monic_of_split
      ((minpoly.monic (power_basis.is_integral_gen _)).map _)
      ((splits_id_iff_splits _).2 hf), nat_degree_map, map_pow, ← mul_assoc, ← mul_pow],
  simp
end

end eq_prod_roots

section eq_zero_iff

lemma norm_eq_zero_iff_of_basis [is_domain R] [is_domain S] (b : basis ι R S) {x : S} :
  algebra.norm R x = 0 ↔ x = 0 :=
begin
  have hι : nonempty ι := b.index_nonempty,
  letI := classical.dec_eq ι,
  rw algebra.norm_eq_matrix_det b,
  split,
  { rw ← matrix.exists_mul_vec_eq_zero_iff,
    rintros ⟨v, v_ne, hv⟩,
    rw [← b.equiv_fun.apply_symm_apply v, b.equiv_fun_symm_apply, b.equiv_fun_apply,
        algebra.left_mul_matrix_mul_vec_repr] at hv,
    refine (mul_eq_zero.mp (b.ext_elem $ λ i, _)).resolve_right (show ∑ i, v i • b i ≠ 0, from _),
    { simpa only [linear_equiv.map_zero, pi.zero_apply] using congr_fun hv i },
    { contrapose! v_ne with sum_eq,
      apply b.equiv_fun.symm.injective,
      rw [b.equiv_fun_symm_apply, sum_eq, linear_equiv.map_zero] } },
  { rintro rfl,
    rw [alg_hom.map_zero, matrix.det_zero hι] },
end

lemma norm_ne_zero_iff_of_basis [is_domain R] [is_domain S] (b : basis ι R S) {x : S} :
  algebra.norm R x ≠ 0 ↔ x ≠ 0 :=
not_iff_not.mpr (algebra.norm_eq_zero_iff_of_basis b)

/-- See also `algebra.norm_eq_zero_iff'` if you already have rewritten with `algebra.norm_apply`. -/
@[simp]
lemma norm_eq_zero_iff [finite_dimensional K L] {x : L} :
  algebra.norm K x = 0 ↔ x = 0 :=
algebra.norm_eq_zero_iff_of_basis (basis.of_vector_space K L)

/-- This is `algebra.norm_eq_zero_iff` composed with `algebra.norm_apply`. -/
@[simp]
lemma norm_eq_zero_iff' [finite_dimensional K L] {x : L} :
  linear_map.det (algebra.lmul K L x) = 0 ↔ x = 0 :=
algebra.norm_eq_zero_iff_of_basis (basis.of_vector_space K L)

end eq_zero_iff

open intermediate_field

variable (K)

lemma norm_eq_norm_adjoin [finite_dimensional K L] [is_separable K L] (x : L) :
  norm K x = norm K (adjoin_simple.gen K x) ^ finrank K⟮x⟯ L :=
begin
  letI := is_separable_tower_top_of_is_separable K K⟮x⟯ L,
  let pbL := field.power_basis_of_finite_of_separable K⟮x⟯ L,
  let pbx := intermediate_field.adjoin.power_basis (is_separable.is_integral K x),
  rw [← adjoin_simple.algebra_map_gen K x, norm_eq_matrix_det (pbx.basis.smul pbL.basis) _,
    smul_left_mul_matrix_algebra_map, det_block_diagonal, norm_eq_matrix_det pbx.basis],
  simp only [finset.card_fin, finset.prod_const],
  congr,
  rw [← power_basis.finrank, adjoin_simple.algebra_map_gen K x]
end

variable {K}

section intermediate_field

lemma _root_.intermediate_field.adjoin_simple.norm_gen_eq_one {x : L}
  (hx : ¬_root_.is_integral K x) : norm K (adjoin_simple.gen K x) = 1 :=
begin
  rw [norm_eq_one_of_not_exists_basis],
  contrapose! hx,
  obtain ⟨s, ⟨b⟩⟩ := hx,
  refine is_integral_of_mem_of_fg (K⟮x⟯).to_subalgebra _ x _,
  { exact (submodule.fg_iff_finite_dimensional _).mpr (of_finset_basis b) },
  { exact intermediate_field.subset_adjoin K _ (set.mem_singleton x) }
end

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

end intermediate_field

section eq_prod_embeddings

open intermediate_field intermediate_field.adjoin_simple polynomial

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

lemma norm_eq_prod_embeddings_gen
  (pb : power_basis K L)
  (hE : (minpoly K pb.gen).splits (algebra_map K E)) (hfx : (minpoly K pb.gen).separable) :
  algebra_map K E (norm K pb.gen) =
    (@@finset.univ (power_basis.alg_hom.fintype pb)).prod (λ σ, σ pb.gen) :=
begin
  letI := classical.dec_eq E,
  rw [power_basis.norm_gen_eq_prod_roots pb hE, fintype.prod_equiv pb.lift_equiv',
    finset.prod_mem_multiset, finset.prod_eq_multiset_prod, multiset.to_finset_val,
    multiset.dedup_eq_self.mpr, multiset.map_id],
  { exact nodup_roots ((separable_map _).mpr hfx) },
  { intro x, refl },
  { intro σ, rw [power_basis.lift_equiv'_apply_coe, id.def] }
end

lemma norm_eq_prod_roots [is_separable K L] [finite_dimensional K L]
  {x : L} (hF : (minpoly K x).splits (algebra_map K F)) :
  algebra_map K F (norm K x) = ((minpoly K x).map (algebra_map K F)).roots.prod ^ finrank K⟮x⟯ L :=
by rw [norm_eq_norm_adjoin K x, map_pow,
  intermediate_field.adjoin_simple.norm_gen_eq_prod_roots _ hF]

variable (F)

lemma prod_embeddings_eq_finrank_pow [algebra L F] [is_scalar_tower K L F][is_alg_closed E]
  [is_separable K F] [finite_dimensional K F] (pb : power_basis K L) :
  ∏ σ : F →ₐ[K] E, σ (algebra_map L F pb.gen) =
  ((@@finset.univ (power_basis.alg_hom.fintype pb)).prod
    (λ σ : L →ₐ[K] E, σ pb.gen)) ^ finrank L F :=
begin
  haveI : finite_dimensional L F := finite_dimensional.right K L F,
  haveI : is_separable L F := is_separable_tower_top_of_is_separable K L F,
  letI : fintype (L →ₐ[K] E) := power_basis.alg_hom.fintype pb,
  letI : ∀ (f : L →ₐ[K] E), fintype (@@alg_hom L F E _ _ _ _ f.to_ring_hom.to_algebra) := _,
  rw [fintype.prod_equiv alg_hom_equiv_sigma (λ (σ : F →ₐ[K] E), _) (λ σ, σ.1 pb.gen),
     ← finset.univ_sigma_univ, finset.prod_sigma, ← finset.prod_pow],
  refine finset.prod_congr rfl (λ σ _, _),
  { letI : algebra L E := σ.to_ring_hom.to_algebra,
    simp only [finset.prod_const, finset.card_univ],
    congr,
    rw alg_hom.card L F E },
  { intros σ,
    simp only [alg_hom_equiv_sigma, equiv.coe_fn_mk, alg_hom.restrict_domain, alg_hom.comp_apply,
         is_scalar_tower.coe_to_alg_hom'] }
end

variable (K)

/-- For `L/K` a finite separable extension of fields and `E` an algebraically closed extension
of `K`, the norm (down to `K`) of an element `x` of `L` is equal to the product of the images
of `x` over all the `K`-embeddings `σ`  of `L` into `E`. -/
lemma norm_eq_prod_embeddings [finite_dimensional K L] [is_separable K L] [is_alg_closed E]
  {x : L} : algebra_map K E (norm K x) = ∏ σ : L →ₐ[K] E, σ x :=
begin
  have hx := is_separable.is_integral K x,
  rw [norm_eq_norm_adjoin K x, ring_hom.map_pow, ← adjoin.power_basis_gen hx,
    norm_eq_prod_embeddings_gen E (adjoin.power_basis hx) (is_alg_closed.splits_codomain _)],
  { exact (prod_embeddings_eq_finrank_pow L E (adjoin.power_basis hx)).symm },
  { haveI := is_separable_tower_bot_of_is_separable K K⟮x⟯ L,
    exact is_separable.separable K _ }
end

lemma is_integral_norm [algebra S L] [algebra S K] [is_scalar_tower S K L]
  [is_separable K L] [finite_dimensional K L] {x : L} (hx : _root_.is_integral S x) :
  _root_.is_integral S (norm K x) :=
begin
  have hx' : _root_.is_integral K x := is_integral_of_is_scalar_tower _ hx,
  rw [← is_integral_algebra_map_iff (algebra_map K (algebraic_closure L)).injective,
      norm_eq_prod_roots],
  { refine (is_integral.multiset_prod (λ y hy, _)).pow _,
    rw mem_roots_map (minpoly.ne_zero hx') at hy,
    use [minpoly S x, minpoly.monic hx],
    rw ← aeval_def at ⊢ hy,
    exact minpoly.aeval_of_is_scalar_tower S x y hy },
  { apply is_alg_closed.splits_codomain },
  { apply_instance }
end

end eq_prod_embeddings

end algebra


import NBG.SetTheory.Defs
import NBG.SetTheory.Axioms.PowerSet

open Classical

-- 13. AxiomInfinity
axiom AxiomInfinity :
  ∃x: Class, (x∈U)
    ∧ ((ø∈x) ∧ ∀n: Class,
      ((hn: n ∈ x) → (n ∪ (@Singleton_mk n (Set.mk₁ hn))) ∈ x))

def isInductive (x: Class) :=
  x∈U
    → ((ø∈x) ∧ ∀n: Class, (
      ((hn: n ∈ x) → (n ∪ (@Singleton_mk n (Set.mk₁ hn))) ∈ x)))
class Inductive (x: Class) where
  isInductive: isInductive x

theorem IndClassExists:
  ∃Ind: Class, ∀x: Class,
    (x∈Ind) ↔ (isInductive x) := sorry

noncomputable def Ind: Class := choose IndClassExists

noncomputable def Omega := ⋂ Ind
notation "ω" => Omega

-- empty set
theorem EmptyClassIsSet: Set ø := by
{
  let x := choose AxiomInfinity;
  have in_x := (choose_spec AxiomInfinity).2.1;
  exact ⟨⟨x, in_x⟩, AllSetInU.1 ⟨x, in_x⟩⟩;
}

-- -- finite set
-- def isFiniteSet (x: Class) :=
--   ∃f: Class, Function f
--     → (Dom f ＝ x) ∧ (Rng f ∈ ω)

-- class Finite where
--   α : Class
--   isFiniteSet : isFiniteSet α


import game.world8.level5 -- hide
namespace mynat -- hide

/-

# Advanced Addition World

## Level 6: `add_left_cancel`

The theorem `add_left_cancel` is the theorem that you can cancel on the left
when you're doing addition -- if `t + a = t + b` then `a = b`.
There is a three-line proof which ends in `exact add_right_cancel a t b` (or even
`exact add_right_cancel _ _ _`); this
strategy involves changing the goal to the statement of `add_right_cancel` somehow.

-/

/- Theorem
On the set of natural numbers, addition has the left cancellation property.
In other words, if there are natural numbers $a, b$ and $t$ such that
$$ t + a = t + b, $$
then we have $a = b$.
-/
theorem add_left_cancel (t a b : mynat) : t + a = t + b → a = b :=
begin [nat_num_game]
  rw add_comm,
  rw add_comm t,
  exact add_right_cancel a t b,

end

end mynat -- hide


/-
Copyright (c) 2022 Yaël Dillies, Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies, Bhavik Mehta
-/
import combinatorics.simple_graph.basic
import order.partition.finpartition

/-!
# Edge density

This file defines the number and density of edges of a relation/graph.

## Main declarations

Between two finsets of vertices,
* `rel.interedges`: Finset of edges of a relation.
* `rel.edge_density`: Edge density of a relation.
* `simple_graph.interedges`: Finset of edges of a graph.
* `simple_graph.edge_density`: Edge density of a graph.
-/

open finset

variables {ι κ α β : Type*}

/-! ### Density of a relation -/

namespace rel
section asymmetric
variables (r : α → β → Prop) [Π a, decidable_pred (r a)] {s s₁ s₂ : finset α} {t t₁ t₂ : finset β}
  {a : α} {b : β}

/-- Finset of edges of a relation between two finsets of vertices. -/
def interedges (s : finset α) (t : finset β) : finset (α × β) :=
(s.product t).filter $ λ e, r e.1 e.2

/-- Edge density of a relation between two finsets of vertices. -/
def edge_density (s : finset α) (t : finset β) : ℚ := (interedges r s t).card / (s.card * t.card)

variables {r}

lemma mem_interedges_iff {x : α × β} : x ∈ interedges r s t ↔ x.1 ∈ s ∧ x.2 ∈ t ∧ r x.1 x.2 :=
by simp only [interedges, and_assoc, mem_filter, finset.mem_product]

lemma mk_mem_interedges_iff : (a, b) ∈ interedges r s t ↔ a ∈ s ∧ b ∈ t ∧ r a b :=
mem_interedges_iff

@[simp] lemma interedges_empty_left (t : finset β) : interedges r ∅ t = ∅ :=
by rw [interedges, finset.empty_product, filter_empty]

lemma interedges_mono (hs : s₂ ⊆ s₁) (ht : t₂ ⊆ t₁) : interedges r s₂ t₂ ⊆ interedges r s₁ t₁ :=
λ x, by { simp_rw mem_interedges_iff, exact λ h, ⟨hs h.1, ht h.2.1, h.2.2⟩ }

variables (r)

lemma card_interedges_add_card_interedges_compl (s : finset α) (t : finset β) :
  (interedges r s t).card + (interedges (λ x y, ¬r x y) s t).card = s.card * t.card :=
begin
  classical,
  rw [←card_product, interedges, interedges, ←card_union_eq, filter_union_filter_neg_eq],
  convert disjoint_filter.2 (λ x _, not_not.2),
end

section decidable_eq
variables [decidable_eq α] [decidable_eq β]

lemma interedges_disjoint_left {s s' : finset α} (hs : disjoint s s') (t : finset β) :
  disjoint (interedges r s t) (interedges r s' t) :=
begin
  rintro x hx,
  rw [inf_eq_inter, mem_inter, mem_interedges_iff, mem_interedges_iff] at hx,
  exact hs (mem_inter.2 ⟨hx.1.1, hx.2.1⟩),
end

lemma interedges_disjoint_right (s : finset α) {t t' : finset β} (ht : disjoint t t') :
  disjoint (interedges r s t) (interedges r s t') :=
begin
  rintro x hx,
  rw [inf_eq_inter, mem_inter, mem_interedges_iff, mem_interedges_iff] at hx,
  exact ht (mem_inter.2 ⟨hx.1.2.1, hx.2.2.1⟩),
end

lemma interedges_bUnion_left (s : finset ι) (t : finset β) (f : ι → finset α) :
  interedges r (s.bUnion f) t = s.bUnion (λ a, interedges r (f a) t) :=
ext $ λ a, by simp only [mem_bUnion, mem_interedges_iff, exists_and_distrib_right]

lemma interedges_bUnion_right (s : finset α) (t : finset ι) (f : ι → finset β) :
  interedges r s (t.bUnion f) = t.bUnion (λ b, interedges r s (f b)) :=
ext $ λ a, by simp only [mem_interedges_iff, mem_bUnion, ←exists_and_distrib_left,
  ←exists_and_distrib_right]

lemma interedges_bUnion (s : finset ι) (t : finset κ) (f : ι → finset α) (g : κ → finset β) :
  interedges r (s.bUnion f) (t.bUnion g) =
    (s.product t).bUnion (λ ab, interedges r (f ab.1) (g ab.2)) :=
by simp_rw [product_bUnion, interedges_bUnion_left, interedges_bUnion_right]

end decidable_eq

lemma card_interedges_le_mul (s : finset α) (t : finset β) :
  (interedges r s t).card ≤ s.card * t.card :=
(card_filter_le _ _).trans (card_product _ _).le

lemma edge_density_nonneg (s : finset α) (t : finset β) : 0 ≤ edge_density r s t :=
by { apply div_nonneg; exact_mod_cast nat.zero_le _ }

lemma edge_density_le_one (s : finset α) (t : finset β) : edge_density r s t ≤ 1 :=
div_le_one_of_le (by exact_mod_cast (card_interedges_le_mul _ _ _)) $
  by exact_mod_cast (nat.zero_le _)

lemma edge_density_add_edge_density_compl (hs : s.nonempty) (ht : t.nonempty) :
  edge_density r s t + edge_density (λ x y, ¬r x y) s t = 1 :=
begin
  rw [edge_density, edge_density, div_add_div_same, div_eq_one_iff_eq],
  { exact_mod_cast card_interedges_add_card_interedges_compl r s t },
  { exact_mod_cast (mul_pos hs.card_pos ht.card_pos).ne' }
end

@[simp] lemma edge_density_empty_left (t : finset β) : edge_density r ∅ t = 0 :=
by rw [edge_density, finset.card_empty, nat.cast_zero, zero_mul, div_zero]

@[simp] lemma edge_density_empty_right (s : finset α) : edge_density r s ∅ = 0 :=
by rw [edge_density, finset.card_empty, nat.cast_zero, mul_zero, div_zero]

end asymmetric

section symmetric
variables (r : α → α → Prop) [decidable_rel r] {s s₁ s₂ t t₁ t₂ : finset α} {a b : α}
variables {r} (hr : symmetric r)
include hr

@[simp] lemma swap_mem_interedges_iff {x : α × α} :
  x.swap ∈ interedges r s t ↔ x ∈ interedges r t s :=
by { rw [mem_interedges_iff, mem_interedges_iff, hr.iff], exact and.left_comm }

lemma mk_mem_interedges_comm : (a, b) ∈ interedges r s t ↔ (b, a) ∈ interedges r t s :=
@swap_mem_interedges_iff _ _ _ _ _ hr (b, a)

lemma card_interedges_comm (s t : finset α) : (interedges r s t).card = (interedges r t s).card :=
finset.card_congr (λ (x : α × α) _, x.swap) (λ x, (swap_mem_interedges_iff hr).2)
  (λ _ _ _ _ h, prod.swap_injective h)
  (λ x h, ⟨x.swap, (swap_mem_interedges_iff hr).2 h, x.swap_swap⟩)

lemma edge_density_comm (s t : finset α) : edge_density r s t = edge_density r t s :=
by rw [edge_density, mul_comm, card_interedges_comm hr, edge_density]

end symmetric
end rel

open rel

/-! ### Density of a graph -/

namespace simple_graph
variables (G : simple_graph α) [decidable_rel G.adj] {s s₁ s₂ t t₁ t₂ : finset α} {a b : α}

/-- Finset of edges of a relation between two finsets of vertices. -/
def interedges (s t : finset α) : finset (α × α) := interedges G.adj s t

/-- Density of edges of a graph between two finsets of vertices. -/
def edge_density : finset α → finset α → ℚ := edge_density G.adj

lemma interedges_def (s t : finset α) :
  G.interedges s t = (s.product t).filter (λ e, G.adj e.1 e.2) := rfl

lemma edge_density_def (s t : finset α) :
  G.edge_density s t = (G.interedges s t).card / (s.card * t.card) := rfl

@[simp] lemma card_interedges_div_card (s t : finset α) :
  ((G.interedges s t).card : ℚ) / (s.card * t.card) = G.edge_density s t := rfl

lemma mem_interedges_iff {x : α × α} : x ∈ G.interedges s t ↔ x.1 ∈ s ∧ x.2 ∈ t ∧ G.adj x.1 x.2 :=
mem_interedges_iff

lemma mk_mem_interedges_iff : (a, b) ∈ G.interedges s t ↔ a ∈ s ∧ b ∈ t ∧ G.adj a b :=
mk_mem_interedges_iff

@[simp] lemma interedges_empty_left (t : finset α) : G.interedges ∅ t = ∅ := interedges_empty_left _

lemma interedges_mono : s₂ ⊆ s₁ → t₂ ⊆ t₁ → G.interedges s₂ t₂ ⊆ G.interedges s₁ t₁ :=
interedges_mono

section decidable_eq
variables [decidable_eq α]

lemma interedges_disjoint_left (hs : disjoint s₁ s₂) (t : finset α) :
  disjoint (G.interedges s₁ t) (G.interedges s₂ t) :=
interedges_disjoint_left _ hs _

lemma interedges_disjoint_right (s : finset α) (ht : disjoint t₁ t₂) :
  disjoint (G.interedges s t₁) (G.interedges s t₂) :=
interedges_disjoint_right _ _ ht

lemma interedges_bUnion_left (s : finset ι) (t : finset α) (f : ι → finset α) :
  G.interedges (s.bUnion f) t = s.bUnion (λ a, G.interedges (f a) t) :=
interedges_bUnion_left _ _ _ _

lemma interedges_bUnion_right (s : finset α) (t : finset ι) (f : ι → finset α) :
  G.interedges s (t.bUnion f) = t.bUnion (λ b, G.interedges s (f b)) :=
interedges_bUnion_right _ _ _ _

lemma interedges_bUnion (s : finset ι) (t : finset κ) (f : ι → finset α) (g : κ → finset α) :
  G.interedges (s.bUnion f) (t.bUnion g) =
    (s.product t).bUnion (λ ab, G.interedges (f ab.1) (g ab.2)) :=
interedges_bUnion _ _ _ _ _

lemma card_interedges_add_card_interedges_compl (h : disjoint s t) :
  (G.interedges s t).card + (Gᶜ.interedges s t).card = s.card * t.card :=
begin
  rw [←card_product, interedges_def, interedges_def],
  have : (s.product t).filter (λ e , Gᶜ.adj e.1 e.2) = (s.product t).filter (λ e , ¬ G.adj e.1 e.2),
  { refine filter_congr (λ x hx, _),
    rw mem_product at hx,
    rw [compl_adj, and_iff_right (h.forall_ne_finset hx.1 hx.2)] },
  rw [this, ←card_union_eq, filter_union_filter_neg_eq],
  exact disjoint_filter.2 (λ x _, not_not.2),
end

lemma edge_density_add_edge_density_compl (hs : s.nonempty) (ht : t.nonempty) (h : disjoint s t) :
  G.edge_density s t + Gᶜ.edge_density s t = 1 :=
begin
  rw [edge_density_def, edge_density_def, div_add_div_same, div_eq_one_iff_eq],
  { exact_mod_cast card_interedges_add_card_interedges_compl _ h },
  { exact_mod_cast (mul_pos hs.card_pos ht.card_pos).ne' }
end

end decidable_eq

lemma card_interedges_le_mul (s t : finset α) : (G.interedges s t).card ≤ s.card * t.card :=
card_interedges_le_mul _ _ _

lemma edge_density_nonneg (s t : finset α) : 0 ≤ G.edge_density s t := edge_density_nonneg _ _ _
lemma edge_density_le_one (s t : finset α) : G.edge_density s t ≤ 1 := edge_density_le_one _ _ _

@[simp] lemma edge_density_empty_left (t : finset α) : G.edge_density ∅ t = 0 :=
edge_density_empty_left _ _

@[simp] lemma edge_density_empty_right (s : finset α) : G.edge_density s ∅ = 0 :=
edge_density_empty_right _ _

@[simp] lemma swap_mem_interedges_iff {x : α × α} :
  x.swap ∈ G.interedges s t ↔ x ∈ G.interedges t s :=
swap_mem_interedges_iff G.symm

lemma mk_mem_interedges_comm : (a, b) ∈ G.interedges s t ↔ (b, a) ∈ G.interedges t s :=
mk_mem_interedges_comm G.symm

lemma edge_density_comm (s t : finset α) : G.edge_density s t = G.edge_density t s :=
edge_density_comm G.symm s t

end simple_graph


/-
Copyright (c) 2021 Yaël Dillies. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies
-/
import data.finset.lattice
import data.set.pairwise

/-!
# Finite supremum independence

In this file, we define supremum independence of indexed sets. An indexed family `f : ι → α` is
sup-independent if, for all `a`, `f a` and the supremum of the rest are disjoint.

In distributive lattices, this is equivalent to being pairwise disjoint.

## TODO

`complete_lattice.independent` and `complete_lattice.set_independent` should live in this file.
-/

variables {α β ι ι' : Type*}

namespace finset
variables [lattice α] [order_bot α] [decidable_eq ι] [decidable_eq ι']

/-- Supremum independence of finite sets. -/
def sup_indep (s : finset ι) (f : ι → α) : Prop := ∀ ⦃a⦄, a ∈ s → disjoint (f a) ((s.erase a).sup f)

variables {s t : finset ι} {f : ι → α}

lemma sup_indep.subset (ht : t.sup_indep f) (h : s ⊆ t) : s.sup_indep f :=
λ a ha, (ht $ h ha).mono_right $ sup_mono $ erase_subset_erase _ h

lemma sup_indep_empty (f : ι → α) : (∅ : finset ι).sup_indep f := λ a ha, ha.elim

lemma sup_indep_singleton (i : ι) (f : ι → α) : ({i} : finset ι).sup_indep f :=
λ j hj, by { rw [mem_singleton.1 hj, erase_singleton, sup_empty], exact disjoint_bot_right }

lemma sup_indep.attach (hs : s.sup_indep f) : s.attach.sup_indep (f ∘ subtype.val) :=
λ i _,
  by { rw [←finset.sup_image, image_erase subtype.val_injective, attach_image_val], exact hs i.2 }

/-- Bind operation for `sup_indep`. -/
lemma sup_indep.sup {α} [distrib_lattice α] [order_bot α] {s : finset ι'} {g : ι' → finset ι}
  {f : ι → α} (hs : s.sup_indep (λ i, (g i).sup f)) (hg : ∀ i' ∈ s, (g i').sup_indep f) :
  (s.sup g).sup_indep f :=
begin
  rintro i hi,
  rw disjoint_sup_right,
  refine λ j hj, _,
  rw mem_sup at hi,
  obtain ⟨i', hi', hi⟩ := hi,
  rw [mem_erase, mem_sup] at hj,
  obtain ⟨hij, j', hj', hj⟩ := hj,
  obtain hij' | hij' := eq_or_ne j' i',
  { exact disjoint_sup_right.1 (hg i' hi' hi) _ (mem_erase.2 ⟨hij, hij'.subst hj⟩) },
  { exact (hs hi').mono (le_sup hi) ((le_sup hj).trans $ le_sup $ mem_erase.2 ⟨hij', hj'⟩) }
end

/-- Bind operation for `sup_indep`. -/
lemma sup_indep.bUnion {α} [distrib_lattice α] [order_bot α] {s : finset ι'} {g : ι' → finset ι}
  {f : ι → α} (hs : s.sup_indep (λ i, (g i).sup f)) (hg : ∀ i' ∈ s, (g i').sup_indep f) :
  (s.bUnion g).sup_indep f :=
by { rw ←sup_eq_bUnion, exact hs.sup hg }

lemma sup_indep.pairwise_disjoint  (hs : s.sup_indep f) : (s : set ι).pairwise_disjoint f :=
λ a ha b hb hab, (hs ha).mono_right $ le_sup $ mem_erase.2 ⟨hab.symm, hb⟩

-- Once `finset.sup_indep` will have been generalized to non distributive lattices, can we state
-- this lemma for nondistributive atomic lattices? This setting makes the `←` implication much
-- harder.
lemma sup_indep_iff_pairwise_disjoint {α} [distrib_lattice α] [order_bot α] {f : ι → α} :
  s.sup_indep f ↔ (s : set ι).pairwise_disjoint f :=
begin
  refine ⟨λ hs a ha b hb hab, (hs ha).mono_right $ le_sup $ mem_erase.2 ⟨hab.symm, hb⟩,
    λ hs a ha, _⟩,
  rw disjoint_sup_right,
  exact λ b hb, hs a ha b (mem_of_mem_erase hb) (ne_of_mem_erase hb).symm,
end

alias sup_indep_iff_pairwise_disjoint ↔ finset.sup_indep.pairwise_disjoint
  set.pairwise_disjoint.sup_indep

end finset

-- TODO: Relax `complete_distrib_lattice` to `complete_lattice` once `finset.sup_indep` is general
-- enough
lemma complete_lattice.independent_iff_sup_indep [complete_distrib_lattice α] [decidable_eq ι]
  {s : finset ι} {f : ι → α} :
  complete_lattice.independent (f ∘ (coe : s → ι)) ↔ s.sup_indep f :=
begin
  refine subtype.forall.trans (forall_congr $ λ a, forall_congr $ λ b, _),
  rw finset.sup_eq_supr,
  congr' 2,
  refine supr_subtype.trans _,
  congr' 1 with x,
  simp [supr_and, @supr_comm _ (x ∈ s)],
end

alias complete_lattice.independent_iff_sup_indep ↔ complete_lattice.independent.sup_indep
  finset.sup_indep.independent


/-
Copyright (c) 2018 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
import data.fin.basic
import data.list.basic
import data.list.join

/-!
# Lists from functions

Theorems and lemmas for dealing with `list.of_fn`, which converts a function on `fin n` to a list
of length `n`.

## Main Statements

The main statements pertain to lists generated using `of_fn`

- `list.length_of_fn`, which tells us the length of such a list
- `list.nth_of_fn`, which tells us the nth element of such a list
- `list.array_eq_of_fn`, which interprets the list form of an array as such a list.
-/

universes u

variables {α : Type u}

open nat
namespace list

lemma length_of_fn_aux {n} (f : fin n → α) :
  ∀ m h l, length (of_fn_aux f m h l) = length l + m
| 0        h l := rfl
| (succ m) h l := (length_of_fn_aux m _ _).trans (succ_add _ _)

/-- The length of a list converted from a function is the size of the domain. -/
@[simp] theorem length_of_fn {n} (f : fin n → α) : length (of_fn f) = n :=
(length_of_fn_aux f _ _ _).trans (zero_add _)

lemma nth_of_fn_aux {n} (f : fin n → α) (i) :
  ∀ m h l,
    (∀ i, nth l i = of_fn_nth_val f (i + m)) →
     nth (of_fn_aux f m h l) i = of_fn_nth_val f i
| 0        h l H := H i
| (succ m) h l H := nth_of_fn_aux m _ _ begin
  intro j, cases j with j,
  { simp only [nth, of_fn_nth_val, zero_add, dif_pos (show m < n, from h)] },
  { simp only [nth, H, add_succ, succ_add] }
end

/-- The `n`th element of a list -/
@[simp] theorem nth_of_fn {n} (f : fin n → α) (i) :
  nth (of_fn f) i = of_fn_nth_val f i :=
nth_of_fn_aux f _ _ _ _ $ λ i,
by simp only [of_fn_nth_val, dif_neg (not_lt.2 (nat.le_add_left n i))]; refl

theorem nth_le_of_fn {n} (f : fin n → α) (i : fin n) :
  nth_le (of_fn f) i ((length_of_fn f).symm ▸ i.2) = f i :=
option.some.inj $ by rw [← nth_le_nth];
  simp only [list.nth_of_fn, of_fn_nth_val, fin.eta, dif_pos i.is_lt]

@[simp] theorem nth_le_of_fn' {n} (f : fin n → α) {i : ℕ} (h : i < (of_fn f).length) :
  nth_le (of_fn f) i h = f ⟨i, ((length_of_fn f) ▸ h)⟩ :=
nth_le_of_fn f ⟨i, ((length_of_fn f) ▸ h)⟩

@[simp] lemma map_of_fn {β : Type*} {n : ℕ} (f : fin n → α) (g : α → β) :
  map g (of_fn f) = of_fn (g ∘ f) :=
ext_le (by simp) (λ i h h', by simp)

/-- Arrays converted to lists are the same as `of_fn` on the indexing function of the array. -/
theorem array_eq_of_fn {n} (a : array n α) : a.to_list = of_fn a.read :=
suffices ∀ {m h l}, d_array.rev_iterate_aux a
  (λ i, cons) m h l = of_fn_aux (d_array.read a) m h l, from this,
begin
  intros, induction m with m IH generalizing l, {refl},
  simp only [d_array.rev_iterate_aux, of_fn_aux, IH]
end

@[congr]
theorem of_fn_congr {m n : ℕ} (h : m = n) (f : fin m → α) :
  of_fn f = of_fn (λ i : fin n, f (fin.cast h.symm i)) :=
begin
  subst h,
  simp_rw [fin.cast_refl, order_iso.refl_apply],
end

/-- `of_fn` on an empty domain is the empty list. -/
@[simp] theorem of_fn_zero (f : fin 0 → α) : of_fn f = [] := rfl

@[simp] theorem of_fn_succ {n} (f : fin (succ n) → α) :
  of_fn f = f 0 :: of_fn (λ i, f i.succ) :=
suffices ∀ {m h l}, of_fn_aux f (succ m) (succ_le_succ h) l =
  f 0 :: of_fn_aux (λ i, f i.succ) m h l, from this,
begin
  intros, induction m with m IH generalizing l, {refl},
  rw [of_fn_aux, IH], refl
end

theorem of_fn_succ' {n} (f : fin (succ n) → α) :
  of_fn f = (of_fn (λ i, f i.cast_succ)).concat (f (fin.last _)) :=
begin
  induction n with n IH,
  { rw [of_fn_zero, concat_nil, of_fn_succ, of_fn_zero], refl },
  { rw [of_fn_succ, IH, of_fn_succ, concat_cons, fin.cast_succ_zero],
    congr' 3,
    simp_rw [fin.cast_succ_fin_succ], }
end

/-- Note this matches the convention of `list.of_fn_succ'`, putting the `fin m` elements first. -/
theorem of_fn_add {m n} (f : fin (m + n) → α) :
  list.of_fn f = list.of_fn (λ i, f (fin.cast_add n i)) ++ list.of_fn (λ j, f (fin.nat_add m j)) :=
begin
  induction n with n IH,
  { rw [of_fn_zero, append_nil, fin.cast_add_zero, fin.cast_refl], refl },
  { rw [of_fn_succ', of_fn_succ', IH, append_concat], refl, },
end

/-- This breaks a list of `m*n` items into `m` groups each containing `n` elements. -/
theorem of_fn_mul {m n} (f : fin (m * n) → α) :
  list.of_fn f = list.join (list.of_fn $ λ i : fin m, list.of_fn $ λ j : fin n,
  f ⟨i * n + j,
    calc ↑i * n + j < (i + 1) *n : (add_lt_add_left j.prop _).trans_eq (add_one_mul _ _).symm
                ... ≤ _ : nat.mul_le_mul_right _ i.prop⟩) :=
begin
  induction m with m IH,
  { simp_rw [of_fn_zero, zero_mul, of_fn_zero, join], },
  { simp_rw [of_fn_succ', succ_mul, join_concat, of_fn_add, IH], refl, },
end

/-- This breaks a list of `m*n` items into `n` groups each containing `m` elements. -/
theorem of_fn_mul' {m n} (f : fin (m * n) → α) :
  list.of_fn f = list.join (list.of_fn $ λ i : fin n, list.of_fn $ λ j : fin m,
  f ⟨m * i + j,
    calc m * i + j < m * (i + 1) : (add_lt_add_left j.prop _).trans_eq (mul_add_one _ _).symm
               ... ≤ _ : nat.mul_le_mul_left _ i.prop⟩) :=
by simp_rw [mul_comm m n, mul_comm m, of_fn_mul, fin.cast_mk]

theorem of_fn_nth_le : ∀ l : list α, of_fn (λ i, nth_le l i i.2) = l
| [] := rfl
| (a::l) := by { rw of_fn_succ, congr, simp only [fin.coe_succ], exact of_fn_nth_le l }

-- not registered as a simp lemma, as otherwise it fires before `forall_mem_of_fn_iff` which
-- is much more useful
lemma mem_of_fn {n} (f : fin n → α) (a : α) :
  a ∈ of_fn f ↔ a ∈ set.range f :=
begin
  simp only [mem_iff_nth_le, set.mem_range, nth_le_of_fn'],
  exact ⟨λ ⟨i, hi, h⟩, ⟨_, h⟩, λ ⟨i, hi⟩, ⟨i.1, (length_of_fn f).symm ▸ i.2, by simpa using hi⟩⟩
end

@[simp] lemma forall_mem_of_fn_iff {n : ℕ} {f : fin n → α} {P : α → Prop} :
  (∀ i ∈ of_fn f, P i) ↔ ∀ j : fin n, P (f j) :=
by simp only [mem_of_fn, set.forall_range_iff]

@[simp] lemma of_fn_const (n : ℕ) (c : α) :
  of_fn (λ i : fin n, c) = repeat c n :=
nat.rec_on n (by simp) $ λ n ihn, by simp [ihn]

end list