/-
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.nat.interval

/-!
# Finite intervals in `fin n`

This file proves that `fin n` is a `locally_finite_order` and calculates the cardinality of its
intervals as finsets and fintypes.
-/

open finset fin

open_locale big_operators

variables (n : ℕ)

instance : locally_finite_order (fin n) := subtype.locally_finite_order _

namespace fin

section bounded
variables {n} (a b : fin n)

lemma Icc_eq_finset_subtype : Icc a b = (Icc (a : ℕ) b).subtype (λ x, x < n) := rfl
lemma Ico_eq_finset_subtype : Ico a b = (Ico (a : ℕ) b).subtype (λ x, x < n) := rfl
lemma Ioc_eq_finset_subtype : Ioc a b = (Ioc (a : ℕ) b).subtype (λ x, x < n) := rfl
lemma Ioo_eq_finset_subtype : Ioo a b = (Ioo (a : ℕ) b).subtype (λ x, x < n) := rfl

@[simp] lemma map_subtype_embedding_Icc :
  (Icc a b).map (function.embedding.subtype _) = Icc (a : ℕ) b :=
map_subtype_embedding_Icc _ _ _ (λ _ c x _ hx _, hx.trans_lt)

@[simp] lemma map_subtype_embedding_Ico :
  (Ico a b).map (function.embedding.subtype _) = Ico (a : ℕ) b :=
map_subtype_embedding_Ico _ _ _ (λ _ c x _ hx _, hx.trans_lt)

@[simp] lemma map_subtype_embedding_Ioc :
  (Ioc a b).map (function.embedding.subtype _) = Ioc (a : ℕ) b :=
map_subtype_embedding_Ioc _ _ _ (λ _ c x _ hx _, hx.trans_lt)

@[simp] lemma map_subtype_embedding_Ioo :
  (Ioo a b).map (function.embedding.subtype _) = Ioo (a : ℕ) b :=
map_subtype_embedding_Ioo _ _ _ (λ _ c x _ hx _, hx.trans_lt)

@[simp] lemma card_Icc : (Icc a b).card = b + 1 - a :=
by rw [←nat.card_Icc, ←map_subtype_embedding_Icc, card_map]

@[simp] lemma card_Ico : (Ico a b).card = b - a :=
by rw [←nat.card_Ico, ←map_subtype_embedding_Ico, card_map]

@[simp] lemma card_Ioc : (Ioc a b).card = b - a :=
by rw [←nat.card_Ioc, ←map_subtype_embedding_Ioc, card_map]

@[simp] lemma card_Ioo : (Ioo a b).card = b - a - 1 :=
by rw [←nat.card_Ioo, ←map_subtype_embedding_Ioo, card_map]

@[simp] lemma card_fintype_Icc : fintype.card (set.Icc a b) = b + 1 - a :=
by rw [←card_Icc, fintype.card_of_finset]

@[simp] lemma card_fintype_Ico : fintype.card (set.Ico a b) = b - a :=
by rw [←card_Ico, fintype.card_of_finset]

@[simp] lemma card_fintype_Ioc : fintype.card (set.Ioc a b) = b - a :=
by rw [←card_Ioc, fintype.card_of_finset]

@[simp] lemma card_fintype_Ioo : fintype.card (set.Ioo a b) = b - a - 1 :=
by rw [←card_Ioo, fintype.card_of_finset]

end bounded

section unbounded
variables {n} (a b : fin (n + 1))

lemma Ici_eq_finset_subtype : Ici a = (Icc (a : ℕ) (n + 1)).subtype (λ x, x < n + 1) :=
begin
  ext x,
  simp only [mem_subtype, mem_Ici, mem_Icc, coe_fin_le, iff_self_and],
  exact λ _, x.2.le,
end

lemma Ioi_eq_finset_subtype : Ioi a = (Ioc (a : ℕ) (n + 1)).subtype (λ x, x < n + 1) :=
begin
  ext x,
  simp only [mem_subtype, mem_Ioi, mem_Ioc, coe_fin_lt, iff_self_and],
  exact λ _, x.2.le,
end

lemma Iic_eq_finset_subtype : Iic b = (Iic (b : ℕ)).subtype (λ x, x < n + 1) := rfl
lemma Iio_eq_finset_subtype : Iio b = (Iio (b : ℕ)).subtype (λ x, x < n + 1) := rfl

@[simp] lemma map_subtype_embedding_Ici : (Ici a).map (function.embedding.subtype _) = Icc a n :=
begin
  ext x,
  simp only [exists_prop, function.embedding.coe_subtype, mem_Ici, mem_map, mem_Icc],
  split,
  { rintro ⟨x, hx, rfl⟩,
    exact ⟨hx, nat.lt_succ_iff.1 x.2⟩ },
  { rintro hx,
    exact ⟨⟨x, nat.lt_succ_iff.2 hx.2⟩, hx.1, rfl⟩ }
end

@[simp] lemma map_subtype_embedding_Ioi : (Ioi a).map (function.embedding.subtype _) = Ioc a n :=
begin
  ext x,
  simp only [exists_prop, function.embedding.coe_subtype, mem_Ioi, mem_map, mem_Ioc],
  refine ⟨_, λ hx, ⟨⟨x, nat.lt_succ_iff.2 hx.2⟩, hx.1, rfl⟩⟩,
  rintro ⟨x, hx, rfl⟩,
  exact ⟨hx, nat.lt_succ_iff.1 x.2⟩,
end

@[simp] lemma map_subtype_embedding_Iic : (Iic b).map (function.embedding.subtype _) = Iic b :=
begin
  ext x,
  simp only [exists_prop, function.embedding.coe_subtype, mem_Iic, mem_map],
  refine ⟨_, λ hx, ⟨⟨x, hx.trans_lt b.2⟩, hx, rfl⟩⟩,
  rintro ⟨x, hx, rfl⟩,
  exact hx,
end

@[simp] lemma map_subtype_embedding_Iio : (Iio b).map (function.embedding.subtype _) = Iio b :=
begin
  ext x,
  simp only [exists_prop, function.embedding.coe_subtype, mem_Iio, mem_map],
  refine ⟨_, λ hx, ⟨⟨x, hx.trans b.2⟩, hx, rfl⟩⟩,
  rintro ⟨x, hx, rfl⟩,
  exact hx,
end

@[simp] lemma card_Ici : (Ici a).card = n + 1 - a :=
by rw [←nat.card_Icc, ←map_subtype_embedding_Ici, card_map]

@[simp] lemma card_Ioi : (Ioi a).card = n - a :=
by rw [←nat.card_Ioc, ←map_subtype_embedding_Ioi, card_map]

@[simp] lemma card_Iic : (Iic b).card = b + 1 :=
by rw [←nat.card_Iic b, ←map_subtype_embedding_Iic, card_map]

@[simp] lemma card_Iio : (Iio b).card = b :=
by rw [←nat.card_Iio b, ←map_subtype_embedding_Iio, card_map]

@[simp] lemma card_fintype_Ici : fintype.card (set.Ici a) = n + 1 - a :=
by rw [fintype.card_of_finset, card_Ici]

@[simp] lemma card_fintype_Ioi : fintype.card (set.Ioi a) = n - a :=
by rw [fintype.card_of_finset, card_Ioi]

@[simp] lemma card_fintype_Iic : fintype.card (set.Iic b) = b + 1 :=
by rw [fintype.card_of_finset, card_Iic]

@[simp] lemma card_fintype_Iio : fintype.card (set.Iio b) = b :=
by rw [fintype.card_of_finset, card_Iio]

end unbounded

section filter

variables {n} (a b : fin n)

@[simp]
lemma card_filter_lt : (finset.univ.filter (λ j, a < j)).card = n - a - 1 :=
begin
  cases n,
  { simp },
  { rw [filter_lt_eq_Ioi, card_Ioi, tsub_tsub],
    exact (add_tsub_add_eq_tsub_right _ 1 _).symm }
end

@[simp]
lemma card_filter_le : (univ.filter (λ j, a ≤ j)).card = n - a :=
begin
  cases n,
  { simp },
  { rw [filter_le_eq_Ici, card_Ici] }
end

@[simp]
lemma card_filter_gt : (finset.univ.filter (λ j, j < a)).card = a :=
begin
  cases n,
  { exact fin.elim0 a },
  { rw [filter_gt_eq_Iio, card_Iio] }
end

@[simp]
lemma card_filter_ge : (finset.univ.filter (λ j, j ≤ a)).card = a + 1 :=
begin
  cases n,
  { exact fin.elim0 a },
  { rw [filter_ge_eq_Iic, card_Iic] }
end

@[simp]
lemma card_filter_lt_lt : (finset.univ.filter (λ j, a < j ∧ j < b)).card = b - a - 1 :=
begin
  cases n,
  { exact fin.elim0 a },
  { rw [filter_lt_lt_eq_Ioo, card_Ioo] }
end

@[simp]
lemma card_filter_lt_le : (finset.univ.filter (λ j, a < j ∧ j ≤ b)).card = b - a :=
begin
  cases n,
  { exact fin.elim0 a },
  { rw [filter_lt_le_eq_Ioc, card_Ioc] }
end

@[simp]
lemma card_filter_le_lt : (finset.univ.filter (λ j, a ≤ j ∧ j < b)).card = b - a :=
begin
  cases n,
  { exact fin.elim0 a },
  { rw [filter_le_lt_eq_Ico, card_Ico] }
end

@[simp]
lemma card_filter_le_le : (finset.univ.filter (λ j, a ≤ j ∧ j ≤ b)).card = b + 1 - a :=
begin
  cases n,
  { exact fin.elim0 a },
  { rw [filter_le_le_eq_Icc, card_Icc] }
end

lemma prod_filter_lt_mul_neg_eq_prod_off_diag {R : Type*} [comm_monoid R] {n : ℕ}
  {f : fin n → fin n → R} :
  ∏ i, (∏ j in univ.filter (λ j, i < j), (f j i) * (f i j)) =
  ∏ i, (∏ j in univ.filter (λ j, i ≠ j), (f j i)) :=
begin
  simp_rw [ne_iff_lt_or_gt, or.comm, filter_or, prod_mul_distrib],
  have : ∀ i : fin n, disjoint (filter (gt i) univ) (filter (has_lt.lt i) univ),
  { simp_rw disjoint_filter,
    intros i x y,
    apply lt_asymm },
  simp only [prod_union, this, prod_mul_distrib],
  rw mul_comm,
  congr' 1,
  rw [prod_sigma', prod_sigma'],
  refine prod_bij' (λ i hi, ⟨i.2, i.1⟩) _ _ (λ i hi, ⟨i.2, i.1⟩) _ _ _; simp
end

end filter

end fin


/-
Copyright (c) 2015 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura, Mario Carneiro
-/
import data.set.function
import logic.equiv.basic

/-!
# Equivalences and sets

In this file we provide lemmas linking equivalences to sets.

Some notable definitions are:

* `equiv.of_injective`: an injective function is (noncomputably) equivalent to its range.
* `equiv.set_congr`: two equal sets are equivalent as types.
* `equiv.set.union`: a disjoint union of sets is equivalent to their `sum`.

This file is separate from `equiv/basic` such that we do not require the full lattice structure
on sets before defining what an equivalence is.
-/

open function set

universes u v w z
variables {α : Sort u} {β : Sort v} {γ : Sort w}

namespace equiv

@[simp] lemma range_eq_univ {α : Type*} {β : Type*} (e : α ≃ β) : range e = univ :=
eq_univ_of_forall e.surjective

protected lemma image_eq_preimage {α β} (e : α ≃ β) (s : set α) : e '' s = e.symm ⁻¹' s :=
set.ext $ λ x, mem_image_iff_of_inverse e.left_inv e.right_inv

lemma _root_.set.mem_image_equiv {α β} {S : set α} {f : α ≃ β} {x : β} :
  x ∈ f '' S ↔ f.symm x ∈ S :=
set.ext_iff.mp (f.image_eq_preimage S) x

/-- Alias for `equiv.image_eq_preimage` -/
lemma _root_.set.image_equiv_eq_preimage_symm {α β} (S : set α) (f : α ≃ β) :
  f '' S = f.symm ⁻¹' S :=
f.image_eq_preimage S

/-- Alias for `equiv.image_eq_preimage` -/
lemma _root_.set.preimage_equiv_eq_image_symm {α β} (S : set α) (f : β ≃ α) :
  f ⁻¹' S = f.symm '' S :=
(f.symm.image_eq_preimage S).symm

@[simp] protected lemma subset_image {α β} (e : α ≃ β) (s : set α) (t : set β) :
  e.symm '' t ⊆ s ↔ t ⊆ e '' s :=
by rw [image_subset_iff, e.image_eq_preimage]

@[simp] protected lemma subset_image' {α β} (e : α ≃ β) (s : set α) (t : set β) :
  s ⊆ e.symm '' t ↔ e '' s ⊆ t :=
calc s ⊆ e.symm '' t ↔ e.symm.symm '' s ⊆ t : by rw e.symm.subset_image
                 ... ↔ e '' s ⊆ t : by rw e.symm_symm

@[simp] lemma symm_image_image {α β} (e : α ≃ β) (s : set α) : e.symm '' (e '' s) = s :=
e.left_inverse_symm.image_image s

lemma eq_image_iff_symm_image_eq {α β} (e : α ≃ β) (s : set α) (t : set β) :
  t = e '' s ↔ e.symm '' t = s :=
(e.symm.injective.image_injective.eq_iff' (e.symm_image_image s)).symm

@[simp] lemma image_symm_image {α β} (e : α ≃ β) (s : set β) : e '' (e.symm '' s) = s :=
e.symm.symm_image_image s

@[simp] lemma image_preimage {α β} (e : α ≃ β) (s : set β) : e '' (e ⁻¹' s) = s :=
e.surjective.image_preimage s

@[simp] lemma preimage_image {α β} (e : α ≃ β) (s : set α) : e ⁻¹' (e '' s) = s :=
e.injective.preimage_image s

protected lemma image_compl {α β} (f : equiv α β) (s : set α) :
  f '' sᶜ = (f '' s)ᶜ :=
image_compl_eq f.bijective

@[simp] lemma symm_preimage_preimage {α β} (e : α ≃ β) (s : set β) :
  e.symm ⁻¹' (e ⁻¹' s) = s :=
e.right_inverse_symm.preimage_preimage s

@[simp] lemma preimage_symm_preimage {α β} (e : α ≃ β) (s : set α) :
  e ⁻¹' (e.symm ⁻¹' s) = s :=
e.left_inverse_symm.preimage_preimage s

@[simp]

@[simp] lemma image_subset {α β} (e : α ≃ β) (s t : set α) : e '' s ⊆ e '' t ↔ s ⊆ t :=
image_subset_image_iff e.injective

@[simp] lemma image_eq_iff_eq {α β} (e : α ≃ β) (s t : set α) : e '' s = e '' t ↔ s = t :=
image_eq_image e.injective

lemma preimage_eq_iff_eq_image {α β} (e : α ≃ β) (s t) : e ⁻¹' s = t ↔ s = e '' t :=
preimage_eq_iff_eq_image e.bijective

lemma eq_preimage_iff_image_eq {α β} (e : α ≃ β) (s t) : s = e ⁻¹' t ↔ e '' s = t :=
eq_preimage_iff_image_eq e.bijective

@[simp] lemma prod_comm_preimage {α β} {s : set α} {t : set β} :
  equiv.prod_comm α β ⁻¹' t ×ˢ s = s ×ˢ t :=
preimage_swap_prod

lemma prod_comm_image {α β} {s : set α} {t : set β} : equiv.prod_comm α β '' s ×ˢ t = t ×ˢ s :=
image_swap_prod

@[simp]
lemma prod_assoc_preimage {α β γ} {s : set α} {t : set β} {u : set γ} :
  equiv.prod_assoc α β γ ⁻¹' s ×ˢ (t ×ˢ u) = (s ×ˢ t) ×ˢ u :=
by { ext, simp [and_assoc] }

@[simp]
lemma prod_assoc_symm_preimage {α β γ} {s : set α} {t : set β} {u : set γ} :
  (equiv.prod_assoc α β γ).symm ⁻¹' (s ×ˢ t) ×ˢ u = s ×ˢ (t ×ˢ u) :=
by { ext, simp [and_assoc] }

-- `@[simp]` doesn't like these lemmas, as it uses `set.image_congr'` to turn `equiv.prod_assoc`
-- into a lambda expression and then unfold it.

lemma prod_assoc_image {α β γ} {s : set α} {t : set β} {u : set γ} :
  equiv.prod_assoc α β γ '' (s ×ˢ t) ×ˢ u = s ×ˢ (t ×ˢ u) :=
by simpa only [equiv.image_eq_preimage] using prod_assoc_symm_preimage

lemma prod_assoc_symm_image {α β γ} {s : set α} {t : set β} {u : set γ} :
  (equiv.prod_assoc α β γ).symm '' s ×ˢ (t ×ˢ u) = (s ×ˢ t) ×ˢ u :=
by simpa only [equiv.image_eq_preimage] using prod_assoc_preimage

/-- A set `s` in `α × β` is equivalent to the sigma-type `Σ x, {y | (x, y) ∈ s}`. -/
def set_prod_equiv_sigma {α β : Type*} (s : set (α × β)) :
  s ≃ Σ x : α, {y | (x, y) ∈ s} :=
{ to_fun := λ x, ⟨x.1.1, x.1.2, by simp⟩,
  inv_fun := λ x, ⟨(x.1, x.2.1), x.2.2⟩,
  left_inv := λ ⟨⟨x, y⟩, h⟩, rfl,
  right_inv := λ ⟨x, y, h⟩, rfl }

/-- The subtypes corresponding to equal sets are equivalent. -/
@[simps apply]
def set_congr {α : Type*} {s t : set α} (h : s = t) : s ≃ t :=
subtype_equiv_prop h

/--
A set is equivalent to its image under an equivalence.
-/
-- We could construct this using `equiv.set.image e s e.injective`,
-- but this definition provides an explicit inverse.
@[simps]
def image {α β : Type*} (e : α ≃ β) (s : set α) : s ≃ e '' s :=
{ to_fun := λ x, ⟨e x.1, by simp⟩,
  inv_fun := λ y, ⟨e.symm y.1, by { rcases y with ⟨-, ⟨a, ⟨m, rfl⟩⟩⟩, simpa using m, }⟩,
  left_inv := λ x, by simp,
  right_inv := λ y, by simp, }.

namespace set

/-- `univ α` is equivalent to `α`. -/
@[simps apply symm_apply]
protected def univ (α) : @univ α ≃ α :=
⟨coe, λ a, ⟨a, trivial⟩, λ ⟨a, _⟩, rfl, λ a, rfl⟩

/-- An empty set is equivalent to the `empty` type. -/
protected def empty (α) : (∅ : set α) ≃ empty :=
equiv_empty _

/-- An empty set is equivalent to a `pempty` type. -/
protected def pempty (α) : (∅ : set α) ≃ pempty :=
equiv_pempty _

/-- If sets `s` and `t` are separated by a decidable predicate, then `s ∪ t` is equivalent to
`s ⊕ t`. -/
protected def union' {α} {s t : set α}
  (p : α → Prop) [decidable_pred p]
  (hs : ∀ x ∈ s, p x)
  (ht : ∀ x ∈ t, ¬ p x) : (s ∪ t : set α) ≃ s ⊕ t :=
{ to_fun := λ x, if hp : p x
    then sum.inl ⟨_, x.2.resolve_right (λ xt, ht _ xt hp)⟩
    else sum.inr ⟨_, x.2.resolve_left (λ xs, hp (hs _ xs))⟩,
  inv_fun := λ o, match o with
    | (sum.inl x) := ⟨x, or.inl x.2⟩
    | (sum.inr x) := ⟨x, or.inr x.2⟩
  end,
  left_inv := λ ⟨x, h'⟩, by by_cases p x; simp [union'._match_1, h]; congr,
  right_inv := λ o, begin
    rcases o with ⟨x, h⟩ | ⟨x, h⟩;
    dsimp [union'._match_1];
    [simp [hs _ h], simp [ht _ h]]
  end }

/-- If sets `s` and `t` are disjoint, then `s ∪ t` is equivalent to `s ⊕ t`. -/
protected def union {α} {s t : set α} [decidable_pred (λ x, x ∈ s)] (H : s ∩ t ⊆ ∅) :
  (s ∪ t : set α) ≃ s ⊕ t :=
set.union' (λ x, x ∈ s) (λ _, id) (λ x xt xs, H ⟨xs, xt⟩)

lemma union_apply_left {α} {s t : set α} [decidable_pred (λ x, x ∈ s)] (H : s ∩ t ⊆ ∅)
  {a : (s ∪ t : set α)} (ha : ↑a ∈ s) : equiv.set.union H a = sum.inl ⟨a, ha⟩ :=
dif_pos ha

lemma union_apply_right {α} {s t : set α} [decidable_pred (λ x, x ∈ s)] (H : s ∩ t ⊆ ∅)
  {a : (s ∪ t : set α)} (ha : ↑a ∈ t) : equiv.set.union H a = sum.inr ⟨a, ha⟩ :=
dif_neg $ λ h, H ⟨h, ha⟩

@[simp] lemma union_symm_apply_left {α} {s t : set α} [decidable_pred (λ x, x ∈ s)] (H : s ∩ t ⊆ ∅)
  (a : s) : (equiv.set.union H).symm (sum.inl a) = ⟨a, subset_union_left _ _ a.2⟩ :=
rfl

@[simp] lemma union_symm_apply_right {α} {s t : set α} [decidable_pred (λ x, x ∈ s)] (H : s ∩ t ⊆ ∅)
  (a : t) : (equiv.set.union H).symm (sum.inr a) = ⟨a, subset_union_right _ _ a.2⟩ :=
rfl

/-- A singleton set is equivalent to a `punit` type. -/
protected def singleton {α} (a : α) : ({a} : set α) ≃ punit.{u} :=
⟨λ _, punit.star, λ _, ⟨a, mem_singleton _⟩,
 λ ⟨x, h⟩, by { simp at h, subst x },
 λ ⟨⟩, rfl⟩

/-- Equal sets are equivalent.

TODO: this is the same as `equiv.set_congr`! -/
@[simps apply symm_apply]
protected def of_eq {α : Type u} {s t : set α} (h : s = t) : s ≃ t :=
equiv.set_congr h

/-- If `a ∉ s`, then `insert a s` is equivalent to `s ⊕ punit`. -/
protected def insert {α} {s : set.{u} α} [decidable_pred (∈ s)] {a : α} (H : a ∉ s) :
  (insert a s : set α) ≃ s ⊕ punit.{u+1} :=
calc (insert a s : set α) ≃ ↥(s ∪ {a}) : equiv.set.of_eq (by simp)
... ≃ s ⊕ ({a} : set α) : equiv.set.union (λ x ⟨hx, hx'⟩, by simp [*] at *)
... ≃ s ⊕ punit.{u+1} : sum_congr (equiv.refl _) (equiv.set.singleton _)

@[simp] lemma insert_symm_apply_inl {α} {s : set.{u} α} [decidable_pred (∈ s)] {a : α} (H : a ∉ s)
  (b : s) : (equiv.set.insert H).symm (sum.inl b) = ⟨b, or.inr b.2⟩ :=
rfl

@[simp] lemma insert_symm_apply_inr {α} {s : set.{u} α} [decidable_pred (∈ s)] {a : α} (H : a ∉ s)
  (b : punit.{u+1}) : (equiv.set.insert H).symm (sum.inr b) = ⟨a, or.inl rfl⟩ :=
rfl

@[simp] lemma insert_apply_left {α} {s : set.{u} α} [decidable_pred (∈ s)] {a : α} (H : a ∉ s) :
  equiv.set.insert H ⟨a, or.inl rfl⟩ = sum.inr punit.star :=
(equiv.set.insert H).apply_eq_iff_eq_symm_apply.2 rfl

@[simp] lemma insert_apply_right {α} {s : set.{u} α} [decidable_pred (∈ s)] {a : α} (H : a ∉ s)
  (b : s) : equiv.set.insert H ⟨b, or.inr b.2⟩ = sum.inl b :=
(equiv.set.insert H).apply_eq_iff_eq_symm_apply.2 rfl

/-- If `s : set α` is a set with decidable membership, then `s ⊕ sᶜ` is equivalent to `α`. -/
protected def sum_compl {α} (s : set α) [decidable_pred (∈ s)] : s ⊕ (sᶜ : set α) ≃ α :=
calc s ⊕ (sᶜ : set α) ≃ ↥(s ∪ sᶜ) : (equiv.set.union (by simp [set.ext_iff])).symm
... ≃ @univ α : equiv.set.of_eq (by simp)
... ≃ α : equiv.set.univ _

@[simp] lemma sum_compl_apply_inl {α : Type u} (s : set α) [decidable_pred (∈ s)] (x : s) :
  equiv.set.sum_compl s (sum.inl x) = x := rfl

@[simp] lemma sum_compl_apply_inr {α : Type u} (s : set α) [decidable_pred (∈ s)] (x : sᶜ) :
  equiv.set.sum_compl s (sum.inr x) = x := rfl

lemma sum_compl_symm_apply_of_mem {α : Type u} {s : set α} [decidable_pred (∈ s)] {x : α}
  (hx : x ∈ s) : (equiv.set.sum_compl s).symm x = sum.inl ⟨x, hx⟩ :=
have ↑(⟨x, or.inl hx⟩ : (s ∪ sᶜ : set α)) ∈ s, from hx,
by { rw [equiv.set.sum_compl], simpa using set.union_apply_left _ this }

lemma sum_compl_symm_apply_of_not_mem {α : Type u} {s : set α} [decidable_pred (∈ s)] {x : α}
  (hx : x ∉ s) : (equiv.set.sum_compl s).symm x = sum.inr ⟨x, hx⟩ :=
have ↑(⟨x, or.inr hx⟩ : (s ∪ sᶜ : set α)) ∈ sᶜ, from hx,
by { rw [equiv.set.sum_compl], simpa using set.union_apply_right _ this }

@[simp] lemma sum_compl_symm_apply {α : Type*} {s : set α} [decidable_pred (∈ s)] {x : s} :
  (equiv.set.sum_compl s).symm x = sum.inl x :=
by cases x with x hx; exact set.sum_compl_symm_apply_of_mem hx

@[simp] lemma sum_compl_symm_apply_compl {α : Type*} {s : set α}
  [decidable_pred (∈ s)] {x : sᶜ} : (equiv.set.sum_compl s).symm x = sum.inr x :=
by cases x with x hx; exact set.sum_compl_symm_apply_of_not_mem hx

/-- `sum_diff_subset s t` is the natural equivalence between
`s ⊕ (t \ s)` and `t`, where `s` and `t` are two sets. -/
protected def sum_diff_subset {α} {s t : set α} (h : s ⊆ t) [decidable_pred (∈ s)] :
  s ⊕ (t \ s : set α) ≃ t :=
calc s ⊕ (t \ s : set α) ≃ (s ∪ (t \ s) : set α) :
  (equiv.set.union (by simp [inter_diff_self])).symm
... ≃ t : equiv.set.of_eq (by { simp [union_diff_self, union_eq_self_of_subset_left h] })

@[simp] lemma sum_diff_subset_apply_inl
  {α} {s t : set α} (h : s ⊆ t) [decidable_pred (∈ s)] (x : s) :
  equiv.set.sum_diff_subset h (sum.inl x) = inclusion h x := rfl

@[simp] lemma sum_diff_subset_apply_inr
  {α} {s t : set α} (h : s ⊆ t) [decidable_pred (∈ s)] (x : t \ s) :
  equiv.set.sum_diff_subset h (sum.inr x) = inclusion (diff_subset t s) x := rfl

lemma sum_diff_subset_symm_apply_of_mem
  {α} {s t : set α} (h : s ⊆ t) [decidable_pred (∈ s)] {x : t} (hx : x.1 ∈ s) :
  (equiv.set.sum_diff_subset h).symm x = sum.inl ⟨x, hx⟩ :=
begin
  apply (equiv.set.sum_diff_subset h).injective,
  simp only [apply_symm_apply, sum_diff_subset_apply_inl],
  exact subtype.eq rfl,
end

lemma sum_diff_subset_symm_apply_of_not_mem
  {α} {s t : set α} (h : s ⊆ t) [decidable_pred (∈ s)] {x : t} (hx : x.1 ∉ s) :
  (equiv.set.sum_diff_subset h).symm x = sum.inr ⟨x, ⟨x.2, hx⟩⟩  :=
begin
  apply (equiv.set.sum_diff_subset h).injective,
  simp only [apply_symm_apply, sum_diff_subset_apply_inr],
  exact subtype.eq rfl,
end

/-- If `s` is a set with decidable membership, then the sum of `s ∪ t` and `s ∩ t` is equivalent
to `s ⊕ t`. -/
protected def union_sum_inter {α : Type u} (s t : set α) [decidable_pred (∈ s)] :
  (s ∪ t : set α) ⊕ (s ∩ t : set α) ≃ s ⊕ t :=
calc  (s ∪ t : set α) ⊕ (s ∩ t : set α)
    ≃ (s ∪ t \ s : set α) ⊕ (s ∩ t : set α) : by rw [union_diff_self]
... ≃ (s ⊕ (t \ s : set α)) ⊕ (s ∩ t : set α) :
  sum_congr (set.union $ subset_empty_iff.2 (inter_diff_self _ _)) (equiv.refl _)
... ≃ s ⊕ (t \ s : set α) ⊕ (s ∩ t : set α) : sum_assoc _ _ _
... ≃ s ⊕ (t \ s ∪ s ∩ t : set α) : sum_congr (equiv.refl _) begin
    refine (set.union' (∉ s) _ _).symm,
    exacts [λ x hx, hx.2, λ x hx, not_not_intro hx.1]
  end
... ≃ s ⊕ t : by { rw (_ : t \ s ∪ s ∩ t = t), rw [union_comm, inter_comm, inter_union_diff] }

/-- Given an equivalence `e₀` between sets `s : set α` and `t : set β`, the set of equivalences
`e : α ≃ β` such that `e ↑x = ↑(e₀ x)` for each `x : s` is equivalent to the set of equivalences
between `sᶜ` and `tᶜ`. -/
protected def compl {α : Type u} {β : Type v} {s : set α} {t : set β} [decidable_pred (∈ s)]
  [decidable_pred (∈ t)] (e₀ : s ≃ t) :
  {e : α ≃ β // ∀ x : s, e x = e₀ x} ≃ ((sᶜ : set α) ≃ (tᶜ : set β)) :=
{ to_fun := λ e, subtype_equiv e
    (λ a, not_congr $ iff.symm $ maps_to.mem_iff
      (maps_to_iff_exists_map_subtype.2 ⟨e₀, e.2⟩)
      (surj_on.maps_to_compl (surj_on_iff_exists_map_subtype.2
        ⟨t, e₀, subset.refl t, e₀.surjective, e.2⟩) e.1.injective)),
  inv_fun := λ e₁,
    subtype.mk
      (calc α ≃ s ⊕ (sᶜ : set α) : (set.sum_compl s).symm
          ... ≃ t ⊕ (tᶜ : set β) : e₀.sum_congr e₁
          ... ≃ β : set.sum_compl t)
      (λ x, by simp only [sum.map_inl, trans_apply, sum_congr_apply,
        set.sum_compl_apply_inl, set.sum_compl_symm_apply]),
  left_inv := λ e,
    begin
      ext x,
      by_cases hx : x ∈ s,
      { simp only [set.sum_compl_symm_apply_of_mem hx, ←e.prop ⟨x, hx⟩,
          sum.map_inl, sum_congr_apply, trans_apply,
          subtype.coe_mk, set.sum_compl_apply_inl] },
      { simp only [set.sum_compl_symm_apply_of_not_mem hx, sum.map_inr,
          subtype_equiv_apply, set.sum_compl_apply_inr, trans_apply,
          sum_congr_apply, subtype.coe_mk] },
    end,
  right_inv := λ e, equiv.ext $ λ x, by simp only [sum.map_inr, subtype_equiv_apply,
    set.sum_compl_apply_inr, function.comp_app, sum_congr_apply, equiv.coe_trans,
    subtype.coe_eta, subtype.coe_mk, set.sum_compl_symm_apply_compl] }

/-- The set product of two sets is equivalent to the type product of their coercions to types. -/
protected def prod {α β} (s : set α) (t : set β) :
  ↥(s ×ˢ t) ≃ s × t :=
@subtype_prod_equiv_prod α β s t

/-- If a function `f` is injective on a set `s`, then `s` is equivalent to `f '' s`. -/
protected noncomputable def image_of_inj_on {α β} (f : α → β) (s : set α) (H : inj_on f s) :
  s ≃ (f '' s) :=
⟨λ p, ⟨f p, mem_image_of_mem f p.2⟩,
 λ p, ⟨classical.some p.2, (classical.some_spec p.2).1⟩,
 λ ⟨x, h⟩, subtype.eq (H (classical.some_spec (mem_image_of_mem f h)).1 h
   (classical.some_spec (mem_image_of_mem f h)).2),
 λ ⟨y, h⟩, subtype.eq (classical.some_spec h).2⟩

/-- If `f` is an injective function, then `s` is equivalent to `f '' s`. -/
@[simps apply]
protected noncomputable def image {α β} (f : α → β) (s : set α) (H : injective f) : s ≃ (f '' s) :=
equiv.set.image_of_inj_on f s (H.inj_on s)

@[simp] protected lemma image_symm_apply {α β} (f : α → β) (s : set α) (H : injective f)
  (x : α) (h : x ∈ s) :
  (set.image f s H).symm ⟨f x, ⟨x, ⟨h, rfl⟩⟩⟩ = ⟨x, h⟩ :=
begin
  apply (set.image f s H).injective,
  simp [(set.image f s H).apply_symm_apply],
end

lemma image_symm_preimage {α β} {f : α → β} (hf : injective f) (u s : set α) :
  (λ x, (set.image f s hf).symm x : f '' s → α) ⁻¹' u = coe ⁻¹' (f '' u) :=
begin
  ext ⟨b, a, has, rfl⟩,
  have : ∀(h : ∃a', a' ∈ s ∧ a' = a), classical.some h = a := λ h, (classical.some_spec h).2,
  simp [equiv.set.image, equiv.set.image_of_inj_on, hf.eq_iff, this],
end

/-- If `α` is equivalent to `β`, then `set α` is equivalent to `set β`. -/
@[simps]
protected def congr {α β : Type*} (e : α ≃ β) : set α ≃ set β :=
⟨λ s, e '' s, λ t, e.symm '' t, symm_image_image e, symm_image_image e.symm⟩

/-- The set `{x ∈ s | t x}` is equivalent to the set of `x : s` such that `t x`. -/
protected def sep {α : Type u} (s : set α) (t : α → Prop) :
  ({ x ∈ s | t x } : set α) ≃ { x : s | t x } :=
(equiv.subtype_subtype_equiv_subtype_inter s t).symm

/-- The set `𝒫 S := {x | x ⊆ S}` is equivalent to the type `set S`. -/
protected def powerset {α} (S : set α) : 𝒫 S ≃ set S :=
{ to_fun := λ x : 𝒫 S, coe ⁻¹' (x : set α),
  inv_fun := λ x : set S, ⟨coe '' x, by rintro _ ⟨a : S, _, rfl⟩; exact a.2⟩,
  left_inv := λ x, by ext y; exact ⟨λ ⟨⟨_, _⟩, h, rfl⟩, h, λ h, ⟨⟨_, x.2 h⟩, h, rfl⟩⟩,
  right_inv := λ x, by ext; simp }

/--
If `s` is a set in `range f`,
then its image under `range_splitting f` is in bijection (via `f`) with `s`.
-/
@[simps]
noncomputable def range_splitting_image_equiv {α β : Type*} (f : α → β) (s : set (range f)) :
  range_splitting f '' s ≃ s :=
{ to_fun := λ x, ⟨⟨f x, by simp⟩,
    (by { rcases x with ⟨x, ⟨y, ⟨m, rfl⟩⟩⟩, simpa [apply_range_splitting f] using m, })⟩,
  inv_fun := λ x, ⟨range_splitting f x, ⟨x, ⟨x.2, rfl⟩⟩⟩,
  left_inv := λ x, by { rcases x with ⟨x, ⟨y, ⟨m, rfl⟩⟩⟩, simp [apply_range_splitting f] },
  right_inv := λ x, by simp [apply_range_splitting f], }

end set

/-- If `f : α → β` has a left-inverse when `α` is nonempty, then `α` is computably equivalent to the
range of `f`.

While awkward, the `nonempty α` hypothesis on `f_inv` and `hf` allows this to be used when `α` is
empty too. This hypothesis is absent on analogous definitions on stronger `equiv`s like
`linear_equiv.of_left_inverse` and `ring_equiv.of_left_inverse` as their typeclass assumptions
are already sufficient to ensure non-emptiness. -/
@[simps]
def of_left_inverse {α β : Sort*}
  (f : α → β) (f_inv : nonempty α → β → α) (hf : Π h : nonempty α, left_inverse (f_inv h) f) :
  α ≃ range f :=
{ to_fun := λ a, ⟨f a, a, rfl⟩,
  inv_fun := λ b, f_inv (nonempty_of_exists b.2) b,
  left_inv := λ a, hf ⟨a⟩ a,
  right_inv := λ ⟨b, a, ha⟩, subtype.eq $ show f (f_inv ⟨a⟩ b) = b,
    from eq.trans (congr_arg f $ by exact ha ▸ (hf _ a)) ha }

/-- If `f : α → β` has a left-inverse, then `α` is computably equivalent to the range of `f`.

Note that if `α` is empty, no such `f_inv` exists and so this definition can't be used, unlike
the stronger but less convenient `of_left_inverse`. -/
abbreviation of_left_inverse' {α β : Sort*}
  (f : α → β) (f_inv : β → α) (hf : left_inverse f_inv f) :
  α ≃ range f :=
of_left_inverse f (λ _, f_inv) (λ _, hf)

/-- If `f : α → β` is an injective function, then domain `α` is equivalent to the range of `f`. -/
@[simps apply]
noncomputable def of_injective {α β} (f : α → β) (hf : injective f) : α ≃ range f :=
equiv.of_left_inverse f
  (λ h, by exactI function.inv_fun f) (λ h, by exactI function.left_inverse_inv_fun hf)

theorem apply_of_injective_symm {α β} {f : α → β} (hf : injective f) (b : range f) :
  f ((of_injective f hf).symm b) = b :=
subtype.ext_iff.1 $ (of_injective f hf).apply_symm_apply b

@[simp] theorem of_injective_symm_apply {α β} {f : α → β} (hf : injective f) (a : α) :
  (of_injective f hf).symm ⟨f a, ⟨a, rfl⟩⟩ = a :=
begin
  apply (of_injective f hf).injective,
  simp [apply_of_injective_symm hf],
end

lemma coe_of_injective_symm {α β} {f : α → β} (hf : injective f) :
  ((of_injective f hf).symm : range f → α) = range_splitting f :=
by { ext ⟨y, x, rfl⟩, apply hf, simp [apply_range_splitting f] }

@[simp] lemma self_comp_of_injective_symm {α β} {f : α → β} (hf : injective f) :
  f ∘ ((of_injective f hf).symm) = coe :=
funext (λ x, apply_of_injective_symm hf x)

lemma of_left_inverse_eq_of_injective {α β : Type*}
  (f : α → β) (f_inv : nonempty α → β → α) (hf : Π h : nonempty α, left_inverse (f_inv h) f) :
  of_left_inverse f f_inv hf = of_injective f
    ((em (nonempty α)).elim (λ h, (hf h).injective) (λ h _ _ _, by
    { haveI : subsingleton α := subsingleton_of_not_nonempty h, simp })) :=
by { ext, simp }

lemma of_left_inverse'_eq_of_injective {α β : Type*}
  (f : α → β) (f_inv : β → α) (hf : left_inverse f_inv f) :
  of_left_inverse' f f_inv hf = of_injective f hf.injective :=
by { ext, simp }

protected lemma set_forall_iff {α β} (e : α ≃ β) {p : set α → Prop} :
  (∀ a, p a) ↔ (∀ a, p (e ⁻¹' a)) :=
e.injective.preimage_surjective.forall

lemma preimage_pi_equiv_pi_subtype_prod_symm_pi {α : Type*} {β : α → Type*}
  (p : α → Prop) [decidable_pred p] (s : Π i, set (β i)) :
  (pi_equiv_pi_subtype_prod p β).symm ⁻¹' pi univ s =
    (pi univ (λ i : {i // p i}, s i)) ×ˢ (pi univ (λ i : {i // ¬p i}, s i)) :=
begin
  ext ⟨f, g⟩,
  simp only [mem_preimage, mem_univ_pi, prod_mk_mem_set_prod_eq, subtype.forall,
    ← forall_and_distrib],
  refine forall_congr (λ i, _),
  dsimp only [subtype.coe_mk],
  by_cases hi : p i; simp [hi]
end

/-- `sigma_fiber_equiv f` for `f : α → β` is the natural equivalence between
the type of all preimages of points under `f` and the total space `α`. -/
-- See also `equiv.sigma_fiber_equiv`.
@[simps] def sigma_preimage_equiv {α β} (f : α → β) : (Σ b, f ⁻¹' {b}) ≃ α :=
sigma_fiber_equiv f

/-- A family of equivalences between preimages of points gives an equivalence between domains. -/
-- See also `equiv.of_fiber_equiv`.
@[simps]
def of_preimage_equiv {α β γ} {f : α → γ} {g : β → γ} (e : Π c, (f ⁻¹' {c}) ≃ (g ⁻¹' {c})) :
  α ≃ β :=
equiv.of_fiber_equiv e

lemma of_preimage_equiv_map {α β γ} {f : α → γ} {g : β → γ}
  (e : Π c, (f ⁻¹' {c}) ≃ (g ⁻¹' {c})) (a : α) : g (of_preimage_equiv e a) = f a :=
equiv.of_fiber_equiv_map e a

end equiv

/-- If a function is a bijection between two sets `s` and `t`, then it induces an
equivalence between the types `↥s` and `↥t`. -/
noncomputable def set.bij_on.equiv {α : Type*} {β : Type*} {s : set α} {t : set β} (f : α → β)
  (h : bij_on f s t) : s ≃ t :=
equiv.of_bijective _ h.bijective

/-- The composition of an updated function with an equiv on a subset can be expressed as an
updated function. -/
lemma dite_comp_equiv_update {α : Type*} {β : Sort*} {γ : Sort*} {s : set α} (e : β ≃ s)
  (v : β → γ) (w : α → γ) (j : β) (x : γ) [decidable_eq β] [decidable_eq α]
  [∀ j, decidable (j ∈ s)] :
  (λ (i : α), if h : i ∈ s then (function.update v j x) (e.symm ⟨i, h⟩) else w i) =
  function.update (λ (i : α), if h : i ∈ s then v (e.symm ⟨i, h⟩) else w i) (e j) x :=
begin
  ext i,
  by_cases h : i ∈ s,
  { rw [dif_pos h,
        function.update_apply_equiv_apply, equiv.symm_symm, function.comp,
        function.update_apply, function.update_apply,
        dif_pos h],
    have h_coe : (⟨i, h⟩ : s) = e j ↔ i = e j := subtype.ext_iff.trans (by rw subtype.coe_mk),
    simp_rw h_coe },
  { have : i ≠ e j,
      by { contrapose! h, have : (e j : α) ∈ s := (e j).2, rwa ← h at this },
    simp [h, this] }
end


/-
Copyright (c) 2020 Jalex Stark. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jalex Stark, Scott Morrison, Eric Wieser, Oliver Nash
-/
import data.matrix.basic
import linear_algebra.matrix.trace

/-!
# Matrices with a single non-zero element.

This file provides `matrix.std_basis_matrix`. The matrix `matrix.std_basis_matrix i j c` has `c`
at position `(i, j)`, and zeroes elsewhere.
-/

variables {l m n : Type*}
variables {R α : Type*}

namespace matrix
open_locale matrix
open_locale big_operators

variables [decidable_eq l] [decidable_eq m] [decidable_eq n]

variables [semiring α]

/--
`std_basis_matrix i j a` is the matrix with `a` in the `i`-th row, `j`-th column,
and zeroes elsewhere.
-/
def std_basis_matrix (i : m) (j : n) (a : α) : matrix m n α :=
(λ i' j', if i = i' ∧ j = j' then a else 0)

@[simp] lemma smul_std_basis_matrix (i : m) (j : n) (a b : α) :
b • std_basis_matrix i j a = std_basis_matrix i j (b • a) :=
by { unfold std_basis_matrix, ext, simp }

@[simp] lemma std_basis_matrix_zero (i : m) (j : n) :
std_basis_matrix i j (0 : α) = 0 :=
by { unfold std_basis_matrix, ext, simp }

lemma std_basis_matrix_add (i : m) (j : n) (a b : α) :
std_basis_matrix i j (a + b) = std_basis_matrix i j a + std_basis_matrix i j b :=
begin
  unfold std_basis_matrix, ext,
  split_ifs with h; simp [h],
end

lemma matrix_eq_sum_std_basis (x : matrix n m α) [fintype n] [fintype m] :
  x = ∑ (i : n) (j : m), std_basis_matrix i j (x i j) :=
begin
  ext, symmetry,
  iterate 2 { rw finset.sum_apply },
  convert fintype.sum_eq_single i _,
  { simp [std_basis_matrix] },
  { intros j hj,
    simp [std_basis_matrix, hj], }
end

-- TODO: tie this up with the `basis` machinery of linear algebra
-- this is not completely trivial because we are indexing by two types, instead of one

-- TODO: add `std_basis_vec`
lemma std_basis_eq_basis_mul_basis (i : m) (j : n) :
std_basis_matrix i j 1 = vec_mul_vec (λ i', ite (i = i') 1 0) (λ j', ite (j = j') 1 0) :=
begin
  ext, norm_num [std_basis_matrix, vec_mul_vec],
  exact ite_and,
end

-- todo: the old proof used fintypes, I don't know `finsupp` but this feels generalizable
@[elab_as_eliminator] protected lemma induction_on' [fintype m] [fintype n]
  {P : matrix m n α → Prop} (M : matrix m n α)
  (h_zero : P 0)
  (h_add : ∀ p q, P p → P q → P (p + q))
  (h_std_basis : ∀ (i : m) (j : n) (x : α), P (std_basis_matrix i j x)) :
  P M :=
begin
  rw [matrix_eq_sum_std_basis M, ← finset.sum_product'],
  apply finset.sum_induction _ _ h_add h_zero,
  { intros, apply h_std_basis, }
end

@[elab_as_eliminator] protected lemma induction_on [fintype m] [fintype n]
  [nonempty m] [nonempty n] {P : matrix m n α → Prop} (M : matrix m n α)
  (h_add : ∀ p q, P p → P q → P (p + q))
  (h_std_basis : ∀ i j x, P (std_basis_matrix i j x)) :
  P M :=
matrix.induction_on' M
begin
  inhabit m,
  inhabit n,
  simpa using h_std_basis (default m) (default n) 0,
end
h_add h_std_basis

namespace std_basis_matrix

section

variables (i : m) (j : n) (c : α) (i' : m) (j' : n)

@[simp] lemma apply_same : std_basis_matrix i j c i j = c := if_pos (and.intro rfl rfl)

@[simp] lemma apply_of_ne (h : ¬((i = i') ∧ (j = j'))) :
  std_basis_matrix i j c i' j' = 0 :=
by { simp only [std_basis_matrix, and_imp, ite_eq_right_iff], tauto }

@[simp] lemma apply_of_row_ne {i i' : m} (hi : i ≠ i') (j j' : n) (a : α) :
  std_basis_matrix i j a i' j' = 0 :=
by simp [hi]

@[simp] lemma apply_of_col_ne (i i' : m) {j j' : n} (hj : j ≠ j') (a : α) :
  std_basis_matrix i j a i' j' = 0 :=
by simp [hj]

end

section

variables (i j : n) (c : α) (i' j' : n)

@[simp] lemma diag_zero (h : j ≠ i) : diag n α α (std_basis_matrix i j c) = 0 :=
funext $ λ k, if_neg $ λ ⟨e₁, e₂⟩, h (e₂.trans e₁.symm)

variable [fintype n]

lemma trace_zero (h : j ≠ i) : trace n α α (std_basis_matrix i j c) = 0 := by simp [h]

@[simp] lemma mul_left_apply_same (b : n) (M : matrix n n α) :
  (std_basis_matrix i j c ⬝ M) i b = c * M j b :=
by simp [mul_apply, std_basis_matrix]

@[simp] lemma mul_right_apply_same (a : n) (M : matrix n n α) :
  (M ⬝ std_basis_matrix i j c) a j = M a i * c :=
by simp [mul_apply, std_basis_matrix, mul_comm]

@[simp] lemma mul_left_apply_of_ne (a b : n) (h : a ≠ i) (M : matrix n n α) :
  (std_basis_matrix i j c ⬝ M) a b = 0 :=
by simp [mul_apply, h.symm]

@[simp] lemma mul_right_apply_of_ne (a b : n) (hbj : b ≠ j) (M : matrix n n α) :
  (M ⬝ std_basis_matrix i j c) a b = 0 :=
by simp [mul_apply, hbj.symm]

@[simp] lemma mul_same (k : n) (d : α) :
  std_basis_matrix i j c ⬝ std_basis_matrix j k d = std_basis_matrix i k (c * d) :=
begin
  ext a b,
  simp only [mul_apply, std_basis_matrix, boole_mul],
  by_cases h₁ : i = a; by_cases h₂ : k = b;
  simp [h₁, h₂],
end

@[simp] lemma mul_of_ne {k l : n} (h : j ≠ k) (d : α) :
  std_basis_matrix i j c ⬝ std_basis_matrix k l d = 0 :=
begin
  ext a b,
  simp only [mul_apply, boole_mul, std_basis_matrix],
  by_cases h₁ : i = a;
  simp [h₁, h, h.symm],
end

end

end std_basis_matrix

end matrix


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

import analysis.special_functions.gamma
import analysis.special_functions.polar_coord
import analysis.convex.complex
import analysis.normed.group.basic
import analysis.complex.cauchy_integral
import measure_theory.group.integration
import analysis.fourier.poisson_summation

/-!
# Gaussian integral

We prove various versions of the formula for the Gaussian integral:
* `integral_gaussian`: for real `b` we have `∫ x:ℝ, exp (-b * x^2) = sqrt (π / b)`.
* `integral_gaussian_complex`: for complex `b` with `0 < re b` we have
  `∫ x:ℝ, exp (-b * x^2) = (π / b) ^ (1 / 2)`.
* `integral_gaussian_Ioi` and `integral_gaussian_complex_Ioi`: variants for integrals over `Ioi 0`.
* `complex.Gamma_one_half_eq`: the formula `Γ (1 / 2) = √π`.

We also prove, more generally, that the Fourier transform of the Gaussian is another Gaussian:

* `integral_cexp_neg_mul_sq_add_const`: for all complex `b` and `c` with `0 < re b` we have
  `∫ (x : ℝ), exp (-b * (x + c) ^ 2) = (π / b) ^ (1 / 2)`.
* `fourier_transform_gaussian`: for all complex `b` and `t` with `0 < re b`, we have
  `∫ x:ℝ, exp (I * t * x) * exp (-b * x^2) = (π / b) ^ (1 / 2) * exp (-t ^ 2 / (4 * b))`.
* `fourier_transform_gaussian_pi`: a variant with `b` and `t` scaled to give a more symmetric
  statement, and formulated in terms of the Fourier transform operator `𝓕`.

As an application, in `real.tsum_exp_neg_mul_int_sq` and `complex.tsum_exp_neg_mul_int_sq`, we use
Poisson summation to prove the identity
`∑' (n : ℤ), exp (-π * a * n ^ 2) = 1 / a ^ (1 / 2) * ∑' (n : ℤ), exp (-π / a * n ^ 2)`
for positive real `a`, or complex `a` with positive real part. (See also
`number_theory.modular_forms.jacobi_theta`.)
-/

noncomputable theory

open real set measure_theory filter asymptotics
open_locale real topology fourier_transform

open complex (hiding exp continuous_exp abs_of_nonneg sq_abs)

notation `cexp` := complex.exp
notation `rexp` := real.exp

lemma exp_neg_mul_sq_is_o_exp_neg {b : ℝ} (hb : 0 < b) :
  (λ x:ℝ, exp (-b * x^2)) =o[at_top] (λ x:ℝ, exp (-x)) :=
begin
  have A : (λ (x : ℝ), -x - -b * x ^ 2) = (λ x, x * (b * x + (- 1))), by { ext x, ring },
  rw [is_o_exp_comp_exp_comp, A],
  apply tendsto.at_top_mul_at_top tendsto_id,
  apply tendsto_at_top_add_const_right at_top (-1 : ℝ),
  exact tendsto.const_mul_at_top hb tendsto_id,
end

lemma rpow_mul_exp_neg_mul_sq_is_o_exp_neg {b : ℝ} (hb : 0 < b) (s : ℝ) :
  (λ x:ℝ, x ^ s * exp (-b * x^2)) =o[at_top] (λ x:ℝ, exp (-(1/2) * x)) :=
begin
  apply ((is_O_refl (λ x:ℝ, x ^ s) at_top).mul_is_o (exp_neg_mul_sq_is_o_exp_neg hb)).trans,
  convert Gamma_integrand_is_o s,
  simp_rw [mul_comm],
end

lemma integrable_on_rpow_mul_exp_neg_mul_sq {b : ℝ} (hb : 0 < b) {s : ℝ} (hs : -1 < s) :
  integrable_on (λ x:ℝ, x ^ s * exp (-b * x^2)) (Ioi 0) :=
begin
  rw [← Ioc_union_Ioi_eq_Ioi (zero_le_one : (0 : ℝ) ≤ 1), integrable_on_union],
  split,
  { rw [←integrable_on_Icc_iff_integrable_on_Ioc],
    refine integrable_on.mul_continuous_on _ _ is_compact_Icc,
    { refine (interval_integrable_iff_integrable_Icc_of_le zero_le_one).mp _,
      exact interval_integral.interval_integrable_rpow' hs },
    { exact (continuous_exp.comp (continuous_const.mul (continuous_pow 2))).continuous_on } },
  { have B : (0 : ℝ) < 1/2, by norm_num,
    apply integrable_of_is_O_exp_neg B _ (is_o.is_O (rpow_mul_exp_neg_mul_sq_is_o_exp_neg hb _)),
    assume x hx,
    have N : x ≠ 0, { refine (zero_lt_one.trans_le _).ne', exact hx },
    apply ((continuous_at_rpow_const _ _ (or.inl N)).mul _).continuous_within_at,
    exact (continuous_exp.comp (continuous_const.mul (continuous_pow 2))).continuous_at },
end

lemma integrable_rpow_mul_exp_neg_mul_sq {b : ℝ} (hb : 0 < b) {s : ℝ} (hs : -1 < s) :
  integrable (λ x:ℝ, x ^ s * exp (-b * x^2)) :=
begin
  rw [← integrable_on_univ, ← @Iio_union_Ici _ _ (0 : ℝ), integrable_on_union,
      integrable_on_Ici_iff_integrable_on_Ioi],
  refine ⟨_, integrable_on_rpow_mul_exp_neg_mul_sq hb hs⟩,
  rw ← (measure.measure_preserving_neg (volume : measure ℝ)).integrable_on_comp_preimage
    ((homeomorph.neg ℝ).to_measurable_equiv.measurable_embedding),
  simp only [function.comp, neg_sq, neg_preimage, preimage_neg_Iio, neg_neg, neg_zero],
  apply integrable.mono' (integrable_on_rpow_mul_exp_neg_mul_sq hb hs),
  { apply measurable.ae_strongly_measurable,
    exact (measurable_id'.neg.pow measurable_const).mul
      ((measurable_id'.pow measurable_const).const_mul (-b)).exp },
  { have : measurable_set (Ioi (0 : ℝ)) := measurable_set_Ioi,
    filter_upwards [ae_restrict_mem this] with x hx,
    have h'x : 0 ≤ x := le_of_lt hx,
    rw [real.norm_eq_abs, abs_mul, abs_of_nonneg (exp_pos _).le],
    apply mul_le_mul_of_nonneg_right _ (exp_pos _).le,
    simpa [abs_of_nonneg h'x] using abs_rpow_le_abs_rpow (-x) s }
end

lemma integrable_exp_neg_mul_sq {b : ℝ} (hb : 0 < b) :
  integrable (λ x:ℝ, exp (-b * x^2)) :=
by simpa using integrable_rpow_mul_exp_neg_mul_sq hb (by norm_num : (-1 : ℝ) < 0)

lemma integrable_on_Ioi_exp_neg_mul_sq_iff {b : ℝ} :
  integrable_on (λ x:ℝ, exp (-b * x^2)) (Ioi 0) ↔ 0 < b :=
begin
  refine ⟨λ h, _, λ h, (integrable_exp_neg_mul_sq h).integrable_on⟩,
  by_contra' hb,
  have : ∫⁻ x:ℝ in Ioi 0, 1 ≤ ∫⁻ x:ℝ in Ioi 0, ‖exp (-b * x^2)‖₊,
  { apply lintegral_mono (λ x, _),
    simp only [neg_mul, ennreal.one_le_coe_iff, ← to_nnreal_one, to_nnreal_le_iff_le_coe,
      real.norm_of_nonneg (exp_pos _).le, coe_nnnorm, one_le_exp_iff, right.nonneg_neg_iff],
    exact mul_nonpos_of_nonpos_of_nonneg hb (sq_nonneg _) },
  simpa using this.trans_lt h.2,
end

lemma integrable_exp_neg_mul_sq_iff {b : ℝ} : integrable (λ x:ℝ, exp (-b * x^2)) ↔ 0 < b :=
⟨λ h, integrable_on_Ioi_exp_neg_mul_sq_iff.mp h.integrable_on, integrable_exp_neg_mul_sq⟩

lemma integrable_mul_exp_neg_mul_sq {b : ℝ} (hb : 0 < b) : integrable (λ x:ℝ, x * exp (-b * x^2)) :=
by simpa using integrable_rpow_mul_exp_neg_mul_sq hb (by norm_num : (-1 : ℝ) < 1)

lemma norm_cexp_neg_mul_sq (b : ℂ) (x : ℝ) : ‖complex.exp (-b * x^2)‖ = exp (-b.re * x^2) :=
by rw [complex.norm_eq_abs, complex.abs_exp, ←of_real_pow, mul_comm (-b) _, of_real_mul_re,
  neg_re, mul_comm]

lemma integrable_cexp_neg_mul_sq {b : ℂ} (hb : 0 < b.re) : integrable (λ x:ℝ, cexp (-b * x^2)) :=
begin
  refine ⟨(complex.continuous_exp.comp
    (continuous_const.mul (continuous_of_real.pow 2))).ae_strongly_measurable, _⟩,
  rw ←has_finite_integral_norm_iff,
  simp_rw norm_cexp_neg_mul_sq,
  exact (integrable_exp_neg_mul_sq hb).2,
end

lemma integrable_mul_cexp_neg_mul_sq {b : ℂ} (hb : 0 < b.re) :
  integrable (λ x:ℝ, ↑x * cexp (-b * x^2)) :=
begin
  refine ⟨(continuous_of_real.mul (complex.continuous_exp.comp _)).ae_strongly_measurable, _⟩,
  { exact continuous_const.mul (continuous_of_real.pow 2) },
  have := (integrable_mul_exp_neg_mul_sq hb).has_finite_integral,
  rw ←has_finite_integral_norm_iff at this ⊢,
  convert this,
  ext1 x,
  rw [norm_mul, norm_mul, norm_cexp_neg_mul_sq b, complex.norm_eq_abs, abs_of_real,
    real.norm_eq_abs, norm_of_nonneg (exp_pos _).le],
end

lemma integral_mul_cexp_neg_mul_sq {b : ℂ} (hb : 0 < b.re) :
  ∫ r:ℝ in Ioi 0, (r : ℂ) * cexp (-b * r ^ 2) = (2 * b)⁻¹ :=
begin
  have hb' : b ≠ 0 := by { contrapose! hb, rw [hb, zero_re], },
  refine tendsto_nhds_unique (interval_integral_tendsto_integral_Ioi _
    (integrable_mul_cexp_neg_mul_sq hb).integrable_on filter.tendsto_id) _,
  have A : ∀ x:ℂ, has_deriv_at (λ x, - (2 * b)⁻¹ * cexp (-b * x^2)) (x * cexp (- b * x^2)) x,
  { intro x,
    convert (((has_deriv_at_pow 2 x)).const_mul (-b)).cexp.const_mul (- (2 * b)⁻¹) using 1,
    field_simp [hb'],
    ring },
  have : ∀ (y : ℝ), ∫ x in 0..(id y), ↑x * cexp (-b * x^2)
      = (- (2 * b)⁻¹ * cexp (-b * y^2)) - (- (2 * b)⁻¹ * cexp (-b * 0^2)) :=
    λ y, interval_integral.integral_eq_sub_of_has_deriv_at
      (λ x hx, (A x).comp_of_real) (integrable_mul_cexp_neg_mul_sq hb).interval_integrable,
  simp_rw this,
  have L : tendsto (λ (x : ℝ), (2 * b)⁻¹ - (2 * b)⁻¹ * cexp (-b * x ^ 2)) at_top
    (𝓝 ((2 * b)⁻¹ - (2 * b)⁻¹ * 0)),
  { refine tendsto_const_nhds.sub (tendsto.const_mul _ $ tendsto_zero_iff_norm_tendsto_zero.mpr _),
    simp_rw norm_cexp_neg_mul_sq b,
    exact tendsto_exp_at_bot.comp
      (tendsto.neg_const_mul_at_top (neg_lt_zero.2 hb) (tendsto_pow_at_top two_ne_zero)) },
  simpa using L,
end

/-- The *square* of the Gaussian integral `∫ x:ℝ, exp (-b * x^2)` is equal to `π / b`. -/
lemma integral_gaussian_sq_complex {b : ℂ} (hb : 0 < b.re) :
  (∫ x:ℝ, cexp (-b * x^2)) ^ 2 = π / b :=
begin
  /- We compute `(∫ exp (-b x^2))^2` as an integral over `ℝ^2`, and then make a polar change
  of coordinates. We are left with `∫ r * exp (-b r^2)`, which has been computed in
  `integral_mul_cexp_neg_mul_sq` using the fact that this function has an obvious primitive. -/
  calc
  (∫ x:ℝ, cexp (-b * (x:ℂ)^2)) ^ 2
      = ∫ p : ℝ × ℝ, cexp (-b * ((p.1) : ℂ) ^ 2) * cexp (-b * ((p.2) : ℂ) ^ 2) :
    by { rw [pow_two, ← integral_prod_mul], refl }
  ... = ∫ p : ℝ × ℝ, cexp (- b * (p.1 ^ 2 + p.2 ^ 2)) :
    by { congr, ext1 p, rw [← complex.exp_add, mul_add], }
  ... = ∫ p in polar_coord.target, (p.1) • cexp (- b * ((p.1 * cos p.2) ^ 2 + (p.1 * sin p.2)^2)) :
    begin
      rw ← integral_comp_polar_coord_symm,
      simp only [polar_coord_symm_apply, of_real_mul, of_real_cos, of_real_sin],
    end
  ... = (∫ r in Ioi (0 : ℝ), r * cexp (-b * r^2)) * (∫ θ in Ioo (-π) π, 1) :
    begin
      rw ← set_integral_prod_mul,
      congr' with p : 1,
      rw mul_one,
      congr,
      conv_rhs { rw [← one_mul ((p.1 : ℂ)^2), ← sin_sq_add_cos_sq (p.2 : ℂ)], },
      ring_exp,
    end
  ... = ↑π / b :
    begin
      have : 0 ≤ π + π, by linarith [real.pi_pos],
      simp only [integral_const, measure.restrict_apply', measurable_set_Ioo, univ_inter,
        volume_Ioo, sub_neg_eq_add, ennreal.to_real_of_real, this],
      rw [←two_mul, real_smul, mul_one, of_real_mul, of_real_bit0, of_real_one,
        integral_mul_cexp_neg_mul_sq hb],
      field_simp [(by { contrapose! hb, rw [hb, zero_re] } : b ≠ 0)],
      ring,
    end
end

theorem integral_gaussian (b : ℝ) : ∫ x, exp (-b * x^2) = sqrt (π / b) :=
begin
  /- First we deal with the crazy case where `b ≤ 0`: then both sides vanish. -/
  rcases le_or_lt b 0 with hb|hb,
  { rw [integral_undef, sqrt_eq_zero_of_nonpos],
    { exact div_nonpos_of_nonneg_of_nonpos pi_pos.le hb },
    { simpa only [not_lt, integrable_exp_neg_mul_sq_iff] using hb } },
  /- Assume now `b > 0`. Then both sides are non-negative and their squares agree. -/
  refine (sq_eq_sq _ (sqrt_nonneg _)).1 _,
  { exact integral_nonneg (λ x, (exp_pos _).le) },
  rw [←of_real_inj, of_real_pow, ←integral_of_real, sq_sqrt (div_pos pi_pos hb).le, of_real_div],
  convert integral_gaussian_sq_complex (by rwa of_real_re : 0 < (b:ℂ).re),
  ext1 x,
  rw [of_real_exp, of_real_mul, of_real_pow, of_real_neg],
end

lemma continuous_at_gaussian_integral (b : ℂ) (hb : 0 < re b) :
  continuous_at (λ c:ℂ, ∫ x:ℝ, cexp (-c * x^2)) b :=
begin
  let f : ℂ → ℝ → ℂ := λ (c : ℂ) (x : ℝ), cexp (-c * x ^ 2),
  obtain ⟨d, hd, hd'⟩ := exists_between hb,
  have f_meas : ∀ (c:ℂ), ae_strongly_measurable (f c) volume := λ c, by
  { apply continuous.ae_strongly_measurable,
    exact complex.continuous_exp.comp (continuous_const.mul (continuous_of_real.pow 2)) },
  have f_int : integrable (f b) volume,
  { simp_rw [←integrable_norm_iff (f_meas b), norm_cexp_neg_mul_sq b],
    exact integrable_exp_neg_mul_sq hb, },
  have f_cts : ∀ (x : ℝ), continuous_at (λ c, f c x) b :=
    λ x, (complex.continuous_exp.comp (continuous_id'.neg.mul continuous_const)).continuous_at,
  have f_le_bd : ∀ᶠ (c : ℂ) in 𝓝 b, ∀ᵐ (x : ℝ), ‖f c x‖ ≤ exp (-d * x ^ 2),
  { refine eventually_of_mem ((continuous_re.is_open_preimage _ is_open_Ioi).mem_nhds hd') _,
    refine λ c hc, ae_of_all _ (λ x, _),
    rw [norm_cexp_neg_mul_sq, exp_le_exp],
    exact mul_le_mul_of_nonneg_right (neg_le_neg (le_of_lt hc)) (sq_nonneg _) },
  exact continuous_at_of_dominated (eventually_of_forall f_meas) f_le_bd
    (integrable_exp_neg_mul_sq hd) (ae_of_all _ f_cts),
end

theorem integral_gaussian_complex {b : ℂ} (hb : 0 < re b) :
  ∫ x:ℝ, cexp (-b * x^2) = (π / b) ^ (1 / 2 : ℂ) :=
begin
  have nv : ∀ {b : ℂ}, (0 < re b) → (b ≠ 0),
  { intros b hb, contrapose! hb, rw hb, simp },
  refine (convex_halfspace_re_gt 0).is_preconnected.eq_of_sq_eq
    _ _ (λ c hc, _) (λ c hc, _) (by simp : 0 < re (1 : ℂ)) _ hb,
  { -- integral is continuous
    exact continuous_at.continuous_on continuous_at_gaussian_integral, },
  { -- `(π / b) ^ (1 / 2 : ℂ)` is continuous
    refine continuous_at.continuous_on (λ b hb, (continuous_at_cpow_const (or.inl _)).comp
      (continuous_at_const.div continuous_at_id (nv hb))),
    rw [div_re, of_real_im, of_real_re, zero_mul, zero_div, add_zero],
    exact div_pos (mul_pos pi_pos hb) (norm_sq_pos.mpr (nv hb)), },
  { -- squares of both sides agree
    dsimp only [pi.pow_apply],
    rw [integral_gaussian_sq_complex hc, sq],
    conv_lhs { rw ←cpow_one (↑π / c)},
    rw ← cpow_add _ _ (div_ne_zero (of_real_ne_zero.mpr pi_ne_zero) (nv hc)),
    norm_num },
  { -- RHS doesn't vanish
    rw [ne.def, cpow_eq_zero_iff, not_and_distrib],
    exact or.inl (div_ne_zero (of_real_ne_zero.mpr pi_ne_zero) (nv hc)) },
  { -- equality at 1
    have : ∀ (x : ℝ), cexp (-1 * x ^ 2) = exp (-1 * x ^ 2),
    { intro x,
      simp only [of_real_exp, neg_mul, one_mul, of_real_neg, of_real_pow] },
    simp_rw [this, integral_of_real],
    conv_rhs {  congr, rw [←of_real_one, ←of_real_div], skip,
      rw [←of_real_one, ←of_real_bit0, ←of_real_div]  },
    rw [←of_real_cpow, of_real_inj],
    convert integral_gaussian (1 : ℝ),
    { rwa [sqrt_eq_rpow] },
    { rw [div_one], exact pi_pos.le } },
end

/- The Gaussian integral on the half-line, `∫ x in Ioi 0, exp (-b * x^2)`, for complex `b`. -/
lemma integral_gaussian_complex_Ioi {b : ℂ} (hb : 0 < re b) :
  ∫ x:ℝ in Ioi 0, cexp (-b * x^2) = (π / b) ^ (1 / 2 : ℂ) / 2 :=
begin
  have full_integral := integral_gaussian_complex hb,
  have : measurable_set (Ioi (0:ℝ)) := measurable_set_Ioi,
  rw [←integral_add_compl this (integrable_cexp_neg_mul_sq hb), compl_Ioi] at full_integral,
  suffices : ∫ x:ℝ in Iic 0, cexp (-b * x^2) = ∫ x:ℝ in Ioi 0, cexp (-b * x^2),
  { rw [this, ←mul_two] at full_integral,
    rwa eq_div_iff, exact two_ne_zero },
  have : ∀ (c : ℝ), ∫ x in 0 .. c, cexp (-b * x^2) = ∫ x in -c .. 0, cexp (-b * x^2),
  { intro c,
    have := @interval_integral.integral_comp_sub_left _ _ _ _ 0 c (λ x, cexp (-b * x^2)) 0,
    simpa [zero_sub, neg_sq, neg_zero] using this },
  have t1 := interval_integral_tendsto_integral_Ioi _
     ((integrable_cexp_neg_mul_sq hb).integrable_on) tendsto_id,
  have t2 : tendsto (λ c:ℝ, ∫ x:ℝ in 0..c,
    cexp (-b * x^2)) at_top (𝓝 ∫ x:ℝ in Iic 0, cexp (-b * x^2)),
  { simp_rw this,
    refine interval_integral_tendsto_integral_Iic _ _ tendsto_neg_at_top_at_bot,
    apply (integrable_cexp_neg_mul_sq hb).integrable_on },
  exact tendsto_nhds_unique t2 t1,
end

/- The Gaussian integral on the half-line, `∫ x in Ioi 0, exp (-b * x^2)`, for real `b`. -/
lemma integral_gaussian_Ioi (b : ℝ) : ∫ x in Ioi 0, exp (-b * x^2) = sqrt (π / b) / 2 :=
begin
  rcases le_or_lt b 0 with hb|hb,
  { rw [integral_undef, sqrt_eq_zero_of_nonpos, zero_div],
    exact div_nonpos_of_nonneg_of_nonpos pi_pos.le hb,
    rwa [←integrable_on, integrable_on_Ioi_exp_neg_mul_sq_iff, not_lt] },
  rw [←of_real_inj, ←integral_of_real],
  convert integral_gaussian_complex_Ioi (by rwa of_real_re : 0 < (b:ℂ).re),
  { ext1 x, simp, },
  { rw [sqrt_eq_rpow, ←of_real_div, of_real_div, of_real_cpow],
    norm_num,
    exact (div_pos pi_pos hb).le, }
end

/-- The special-value formula `Γ(1/2) = √π`, which is equivalent to the Gaussian integral. -/
lemma real.Gamma_one_half_eq : real.Gamma (1 / 2) = sqrt π :=
begin
  rw [Gamma_eq_integral one_half_pos, ←integral_comp_rpow_Ioi_of_pos zero_lt_two],
  convert congr_arg (λ x:ℝ, 2 * x) (integral_gaussian_Ioi 1),
  { rw ←integral_mul_left,
    refine set_integral_congr measurable_set_Ioi (λ x hx, _),
    dsimp only,
    have : (x ^ (2:ℝ)) ^ (1 / (2:ℝ) - 1) = x⁻¹,
    { rw ←rpow_mul (le_of_lt hx),
      norm_num,
      rw [rpow_neg (le_of_lt hx), rpow_one] },
    rw [smul_eq_mul, this],
    field_simp [(ne_of_lt hx).symm],
    norm_num, ring },
  { rw [div_one, ←mul_div_assoc, mul_comm, mul_div_cancel _ (two_ne_zero' ℝ)], }
end

/-- The special-value formula `Γ(1/2) = √π`, which is equivalent to the Gaussian integral. -/
lemma complex.Gamma_one_half_eq : complex.Gamma (1 / 2) = π ^ (1 / 2 : ℂ) :=
begin
  convert congr_arg coe real.Gamma_one_half_eq,
  { simpa only [one_div, of_real_inv, of_real_bit0] using Gamma_of_real (1 / 2)},
  { rw [sqrt_eq_rpow, of_real_cpow pi_pos.le, of_real_div, of_real_bit0, of_real_one] }
end

namespace gaussian_fourier
/-! ## Fourier transform of the Gaussian integral
-/
open interval_integral
open_locale real

variables {b : ℂ}

/-- The integral of the Gaussian function over the vertical edges of a rectangle
with vertices at `(±T, 0)` and `(±T, c)`.  -/
def vertical_integral (b : ℂ) (c T : ℝ) : ℂ :=
∫ (y : ℝ) in 0..c, I * (cexp (-b * (T + y * I) ^ 2) - cexp (-b * (T - y * I) ^ 2))

/-- Explicit formula for the norm of the Gaussian function along the vertical
edges. -/
lemma norm_cexp_neg_mul_sq_add_mul_I (b : ℂ) (c T : ℝ) :
  ‖cexp (-b * (T + c * I) ^ 2)‖ = exp (-(b.re * T ^ 2 - 2 * b.im * c * T - b.re * c ^ 2)) :=
begin
  rw [complex.norm_eq_abs, complex.abs_exp, neg_mul, neg_re, ←re_add_im b],
  simp only [sq, re_add_im, mul_re, mul_im, add_re, add_im, of_real_re, of_real_im, I_re, I_im],
  ring_nf,
end

lemma norm_cexp_neg_mul_sq_add_mul_I' (hb : b.re ≠ 0) (c T : ℝ) :
  ‖cexp (-b * (T + c * I) ^ 2)‖ =
  exp (-(b.re * (T - b.im * c / b.re) ^ 2 - c ^ 2 * (b.im ^ 2 / b.re  + b.re))) :=
begin
  have : (b.re * T ^ 2 - 2 * b.im * c * T - b.re * c ^ 2) =
  b.re * (T - b.im * c / b.re) ^ 2 - c ^ 2 * (b.im ^ 2 / b.re  + b.re),
  { field_simp, ring },
  rw [norm_cexp_neg_mul_sq_add_mul_I, this],
end

lemma vertical_integral_norm_le (hb : 0 < b.re) (c : ℝ) {T : ℝ} (hT : 0 ≤ T) :
  ‖vertical_integral b c T‖
    ≤ 2 * |c| * exp (-(b.re * T ^ 2 - 2 * |b.im| * |c| * T - b.re * c ^ 2)) :=
begin
  -- first get uniform bound for integrand
  have vert_norm_bound : ∀ {T : ℝ}, 0 ≤ T → ∀ {c y : ℝ}, |y| ≤ |c| →
    ‖cexp (-b * (T + y * I) ^ 2)‖ ≤ exp (-(b.re * T ^ 2 - 2 * |b.im| * |c| * T - b.re * c ^ 2)),
  { intros T hT c y hy,
    rw [norm_cexp_neg_mul_sq_add_mul_I b, exp_le_exp, neg_le_neg_iff],
    refine sub_le_sub (sub_le_sub (le_refl _) (mul_le_mul_of_nonneg_right _ hT)) _,
    { conv_lhs {rw mul_assoc}, conv_rhs {rw mul_assoc},
      refine mul_le_mul_of_nonneg_left ((le_abs_self _).trans _) zero_le_two,
      rw abs_mul,
      exact mul_le_mul_of_nonneg_left hy (abs_nonneg _), },
    { refine mul_le_mul_of_nonneg_left _ hb.le,
      rwa sq_le_sq, } },
  -- now main proof
  refine (interval_integral.norm_integral_le_of_norm_le_const _).trans _,
  swap 3,
  { rw sub_zero,
    conv_lhs { rw mul_comm },
    conv_rhs { conv { congr, rw mul_comm }, rw mul_assoc } },
  { intros y hy,
    have absy : |y| ≤ |c|,
    { rcases le_or_lt 0 c,
      { rw uIoc_of_le h at hy,
        rw [abs_of_nonneg h, abs_of_pos hy.1],
        exact hy.2, },
      { rw uIoc_of_lt h at hy,
        rw [abs_of_neg h, abs_of_nonpos hy.2, neg_le_neg_iff],
        exact hy.1.le } },
    rw [norm_mul, complex.norm_eq_abs, abs_I, one_mul, two_mul],
    refine (norm_sub_le _ _).trans (add_le_add (vert_norm_bound hT absy) _),
    rw ←abs_neg y at absy,
    simpa only [neg_mul, of_real_neg] using vert_norm_bound hT absy },
end

lemma tendsto_vertical_integral (hb : 0 < b.re) (c : ℝ) :
  tendsto (vertical_integral b c) at_top (𝓝 0) :=
begin
  -- complete proof using squeeze theorem:
  rw tendsto_zero_iff_norm_tendsto_zero,
  refine tendsto_of_tendsto_of_tendsto_of_le_of_le' tendsto_const_nhds _
    (eventually_of_forall (λ _, norm_nonneg _))
    ((eventually_ge_at_top (0:ℝ)).mp (eventually_of_forall
      (λ T hT, vertical_integral_norm_le hb c hT))),
  rw (by ring : 0 = 2 * |c| * 0),
  refine (tendsto_exp_at_bot.comp (tendsto_neg_at_top_at_bot.comp _)).const_mul _ ,
  apply tendsto_at_top_add_const_right,
  simp_rw [sq, ←mul_assoc, ←sub_mul],
  refine tendsto.at_top_mul_at_top (tendsto_at_top_add_const_right _ _ _) tendsto_id,
  exact (tendsto_const_mul_at_top_of_pos hb).mpr tendsto_id,
end

lemma integrable_cexp_neg_mul_sq_add_real_mul_I (hb : 0 < b.re) (c : ℝ) :
  integrable (λ (x : ℝ), cexp (-b * (x + c * I) ^ 2)) :=
begin
  refine ⟨(complex.continuous_exp.comp (continuous_const.mul ((continuous_of_real.add
    continuous_const).pow 2))).ae_strongly_measurable, _⟩,
  rw ←has_finite_integral_norm_iff,
  simp_rw [norm_cexp_neg_mul_sq_add_mul_I' hb.ne', neg_sub _ (c ^ 2 * _),
    sub_eq_add_neg _ (b.re * _), real.exp_add],
  suffices : integrable (λ (x : ℝ), exp (-(b.re * x ^ 2))),
  { exact (integrable.comp_sub_right this (b.im * c / b.re)).has_finite_integral.const_mul _, },
  simp_rw ←neg_mul,
  apply integrable_exp_neg_mul_sq hb,
end

lemma integral_cexp_neg_mul_sq_add_real_mul_I (hb : 0 < b.re) (c : ℝ) :
  ∫ (x : ℝ), cexp (-b * (x + c * I) ^ 2) = (π / b) ^ (1 / 2 : ℂ) :=
begin
  refine tendsto_nhds_unique (interval_integral_tendsto_integral
    (integrable_cexp_neg_mul_sq_add_real_mul_I hb c) tendsto_neg_at_top_at_bot tendsto_id) _,
  set I₁ := (λ T, ∫ (x : ℝ) in -T..T, cexp (-b * (x + c * I) ^ 2)) with HI₁,
  let I₂ := λ (T : ℝ), ∫ (x : ℝ) in -T..T, cexp (-b * x ^ 2),
  let I₄ := λ (T : ℝ), ∫ (y : ℝ) in 0..c, cexp (-b * (T + y * I) ^ 2),
  let I₅ := λ (T : ℝ), ∫ (y : ℝ) in 0..c, cexp (-b * (-T + y * I) ^ 2),
  have C : ∀ (T : ℝ), I₂ T - I₁ T + I * I₄ T - I * I₅ T = 0,
  { assume T,
    have := integral_boundary_rect_eq_zero_of_differentiable_on
    (λ z, cexp (-b * z ^ 2)) (-T) (T + c * I)
    (by { refine differentiable.differentiable_on (differentiable.const_mul _ _).cexp,
    exact differentiable_pow 2, }),
    simpa only [neg_im, of_real_im, neg_zero, of_real_zero, zero_mul, add_zero, neg_re, of_real_re,
      add_re, mul_re, I_re, mul_zero, I_im, tsub_zero, add_im, mul_im, mul_one, zero_add,
      algebra.id.smul_eq_mul, of_real_neg] using this },
  simp_rw [id.def, ←HI₁],
  have : I₁ = λ (T : ℝ), I₂ T + vertical_integral b c T,
  { ext1 T,
    specialize C T,
    rw sub_eq_zero at C,
    unfold vertical_integral,
    rw [integral_const_mul, interval_integral.integral_sub],
    { simp_rw (λ a b, by { rw sq, ring_nf } : ∀ (a b : ℂ), (a - b * I)^2 = (- a + b * I)^2),
      change I₁ T = I₂ T + I * (I₄ T - I₅ T),
      rw [mul_sub, ←C],
      abel },
    all_goals { apply continuous.interval_integrable, continuity }, },
  rw [this, ←add_zero ((π / b : ℂ) ^ (1 / 2 : ℂ)), ←integral_gaussian_complex hb],
  refine tendsto.add _ (tendsto_vertical_integral hb c),
  exact interval_integral_tendsto_integral (integrable_cexp_neg_mul_sq hb)
    tendsto_neg_at_top_at_bot tendsto_id,
end

lemma _root_.integral_cexp_neg_mul_sq_add_const (hb : 0 < b.re) (c : ℂ) :
  ∫ (x : ℝ), cexp (-b * (x + c) ^ 2) = (π / b) ^ (1 / 2 : ℂ) :=
begin
  rw ←re_add_im c,
  simp_rw [←add_assoc, ←of_real_add],
  rw integral_add_right_eq_self (λ(x : ℝ), cexp (-b * (↑x + ↑(c.im) * I) ^ 2)),
  { apply integral_cexp_neg_mul_sq_add_real_mul_I hb },
  { apply_instance },
end

lemma _root_.fourier_transform_gaussian (hb : 0 < b.re) (t : ℂ) :
  ∫ (x : ℝ), cexp (I * t * x) * cexp (-b * x ^ 2) = cexp (-t^2 / (4 * b)) * (π / b) ^ (1 / 2 : ℂ) :=
begin
  have : b ≠ 0,
  { contrapose! hb, rw [hb, zero_re] },
  simp_rw [←complex.exp_add],
  have : ∀ (x : ℂ), I * t * x + (-b * x ^ 2) = -t ^ 2 / (4 * b) + -b * (x + (-I * t / 2 / b)) ^ 2,
  { intro x,
    ring_nf SOP,
    rw I_sq,
    field_simp, ring },
  simp_rw [this, complex.exp_add, integral_mul_left, integral_cexp_neg_mul_sq_add_const hb]
end

lemma _root_.fourier_transform_gaussian_pi (hb : 0 < b.re) :
  𝓕 (λ x : ℝ, cexp (-π * b * x ^ 2)) = λ t : ℝ, 1 / b ^ (1 / 2 : ℂ) * cexp (-π / b * t ^ 2) :=
begin
  ext1 t,
  simp_rw [fourier_integral_eq_integral_exp_smul, smul_eq_mul],
  have h1 : 0 < re (π * b) := by { rw of_real_mul_re, exact mul_pos pi_pos hb },
  have h2 : b ≠ 0 := by { contrapose! hb, rw [hb, zero_re], },
  convert _root_.fourier_transform_gaussian h1 (-2 * π * t) using 1,
  { congr' 1 with x:1,
    congr' 2,
    all_goals { push_cast, ring } },
  { conv_lhs { rw mul_comm },
    congr' 2,
    { field_simp [of_real_ne_zero.mpr pi_ne_zero], ring, },
    { rw [←div_div, div_self (of_real_ne_zero.mpr pi_ne_zero), one_div, one_div b, inv_cpow],
      rw [ne.def, arg_eq_pi_iff, not_and_distrib, not_lt],
      exact or.inl hb.le } },
end

end gaussian_fourier

section gaussian_poisson
/-! ## Poisson summation applied to the Gaussian -/

variables {E : Type*} [normed_add_comm_group E]

lemma tendsto_rpow_abs_mul_exp_neg_mul_sq_cocompact {a : ℝ} (ha : 0 < a) (s : ℝ) :
  tendsto (λ x : ℝ, |x| ^ s * rexp (-a * x ^ 2)) (cocompact ℝ) (𝓝 0) :=
begin
  conv in (rexp _) { rw ←sq_abs },
  rw [cocompact_eq, ←comap_abs_at_top,
    @tendsto_comap'_iff _ _ _ (λ y, y ^ s * rexp (-a * y ^ 2)) _ _ _
    (mem_at_top_sets.mpr ⟨0, λ b hb, ⟨b, abs_of_nonneg hb⟩⟩)],
  exact (rpow_mul_exp_neg_mul_sq_is_o_exp_neg ha s).tendsto_zero_of_tendsto
    (tendsto_exp_at_bot.comp $ tendsto_id.neg_const_mul_at_top (neg_lt_zero.mpr one_half_pos)),
end

lemma is_o_exp_neg_mul_sq_cocompact {a : ℂ} (ha : 0 < a.re) (s : ℝ) :
  (λ x : ℝ, complex.exp (-a * x ^ 2)) =o[cocompact ℝ] (λ x : ℝ, |x| ^ s) :=
begin
  rw ←is_o_norm_left,
  simp_rw norm_cexp_neg_mul_sq,
  apply is_o_of_tendsto',
  { refine eventually.filter_mono cocompact_le_cofinite _,
    refine (eventually_cofinite_ne 0).mp (eventually_of_forall (λ x hx h, _)),
    exact ((rpow_pos_of_pos (abs_pos.mpr hx) _).ne' h).elim },
  { refine tendsto.congr' (eventually.filter_mono cocompact_le_cofinite _)
      (tendsto_zero_iff_norm_tendsto_zero.mp $
      tendsto_rpow_abs_mul_exp_neg_mul_sq_cocompact ha (-s)),
    refine (eventually_cofinite_ne 0).mp (eventually_of_forall (λ x hx, _)),
    rw [norm_mul, norm_of_nonneg (rpow_nonneg_of_nonneg (abs_nonneg _) _), mul_comm,
      rpow_neg (abs_nonneg x), div_eq_mul_inv, norm_of_nonneg (exp_pos _).le] },
end

lemma complex.tsum_exp_neg_mul_int_sq {a : ℂ} (ha : 0 < a.re) :
  ∑' (n : ℤ), cexp (-π * a * n ^ 2) = 1 / a ^ (1 / 2 : ℂ) * ∑' (n : ℤ), cexp (-π / a * n ^ 2) :=
begin
  let f := λ x : ℝ, cexp (-π * a * x ^ 2),
  have h1 : 0 < (↑π * a).re,
  { rw [of_real_mul_re],
    exact mul_pos pi_pos ha },
  have h2 : 0 < (↑π / a).re,
  { rw [div_eq_mul_inv, of_real_mul_re, inv_re],
    refine mul_pos pi_pos (div_pos ha $ norm_sq_pos.mpr _),
    contrapose! ha,
    rw [ha, zero_re] },
  have f_bd : f =O[cocompact ℝ] (λ x, |x| ^ (-2 : ℝ)),
  { convert (is_o_exp_neg_mul_sq_cocompact h1 _).is_O,
    ext1 x,
    dsimp only [f],
    congr' 1,
    ring },
  have Ff_bd : 𝓕 f =O[cocompact ℝ] (λ x, |x| ^ (-2 : ℝ)),
  { rw fourier_transform_gaussian_pi ha,
    convert (is_o_exp_neg_mul_sq_cocompact h2 _).is_O.const_mul_left _,
    ext1 x,
    congr' 1,
    ring_nf },
  simpa only [fourier_transform_gaussian_pi ha, tsum_mul_left] using
    real.tsum_eq_tsum_fourier_integral_of_rpow_decay
    (complex.continuous_exp.comp (continuous_const.mul (continuous_of_real.pow 2)) : continuous f)
    one_lt_two f_bd Ff_bd
end

lemma real.tsum_exp_neg_mul_int_sq {a : ℝ} (ha : 0 < a) :
  ∑' (n : ℤ), exp (-π * a * n ^ 2) = 1 / a ^ (1 / 2 : ℝ) * ∑' (n : ℤ), exp (-π / a * n ^ 2) :=
by simpa only [←of_real_inj, of_real_mul, of_real_tsum, of_real_exp, of_real_div, of_real_pow,
  of_real_int_cast, of_real_neg, of_real_cpow ha.le, of_real_bit0, of_real_one] using
  complex.tsum_exp_neg_mul_int_sq (by rwa [of_real_re] : 0 < (a : ℂ).re)

end gaussian_poisson


/-
Copyright (c) 2020 Kyle Miller All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kyle Miller
-/
import data.sym.basic
import tactic.linarith

/-!
# The symmetric square

This file defines the symmetric square, which is `α × α` modulo
swapping.  This is also known as the type of unordered pairs.

More generally, the symmetric square is the second symmetric power
(see `data.sym.basic`). The equivalence is `sym2.equiv_sym`.

From the point of view that an unordered pair is equivalent to a
multiset of cardinality two (see `sym2.equiv_multiset`), there is a
`has_mem` instance `sym2.mem`, which is a `Prop`-valued membership
test.  Given `h : a ∈ z` for `z : sym2 α`, then `h.other` is the other
element of the pair, defined using `classical.choice`.  If `α` has
decidable equality, then `h.other'` computably gives the other element.

The universal property of `sym2` is provided as `sym2.lift`, which
states that functions from `sym2 α` are equivalent to symmetric
two-argument functions from `α`.

Recall that an undirected graph (allowing self loops, but no multiple
edges) is equivalent to a symmetric relation on the vertex type `α`.
Given a symmetric relation on `α`, the corresponding edge set is
constructed by `sym2.from_rel` which is a special case of `sym2.lift`.

## Notation

The symmetric square has a setoid instance, so `⟦(a, b)⟧` denotes a
term of the symmetric square.

## Tags

symmetric square, unordered pairs, symmetric powers
-/

open finset fintype function sym

universe u
variables {α β γ : Type*}

namespace sym2

/--
This is the relation capturing the notion of pairs equivalent up to permutations.
-/
inductive rel (α : Type u) : (α × α) → (α × α) → Prop
| refl (x y : α) : rel (x, y) (x, y)
| swap (x y : α) : rel (x, y) (y, x)

attribute [refl] rel.refl

@[symm] lemma rel.symm {x y : α × α} : rel α x y → rel α y x :=
by rintro ⟨_, _⟩; constructor

@[trans] lemma rel.trans {x y z : α × α} (a : rel α x y) (b : rel α y z) : rel α x z :=
by { cases_matching* rel _ _ _; apply rel.refl <|> apply rel.swap }

lemma rel.is_equivalence : equivalence (rel α) := by tidy; apply rel.trans; assumption

instance rel.setoid (α : Type u) : setoid (α × α) := ⟨rel α, rel.is_equivalence⟩

@[simp] lemma rel_iff {x y z w : α} :
  (x, y) ≈ (z, w) ↔ (x = z ∧ y = w) ∨ (x = w ∧ y = z) :=
begin
  split; intro h,
  { cases h; simp },
  { cases h; rw [h.1, h.2], constructor }
end

end sym2

/--
`sym2 α` is the symmetric square of `α`, which, in other words, is the
type of unordered pairs.

It is equivalent in a natural way to multisets of cardinality 2 (see
`sym2.equiv_multiset`).
-/
@[reducible]
def sym2 (α : Type u) := quotient (sym2.rel.setoid α)

namespace sym2

@[elab_as_eliminator]
protected lemma ind {f : sym2 α → Prop} (h : ∀ x y, f ⟦(x, y)⟧) : ∀ i, f i :=
quotient.ind $ prod.rec $ by exact h

@[elab_as_eliminator]
protected lemma induction_on {f : sym2 α → Prop} (i : sym2 α) (hf : ∀ x y, f ⟦(x,y)⟧) : f i :=
i.ind hf

protected lemma «exists» {α : Sort*} {f : sym2 α → Prop} :
  (∃ (x : sym2 α), f x) ↔ ∃ x y, f ⟦(x, y)⟧ :=
(surjective_quotient_mk _).exists.trans prod.exists

protected lemma «forall» {α : Sort*} {f : sym2 α → Prop} :
  (∀ (x : sym2 α), f x) ↔ ∀ x y, f ⟦(x, y)⟧ :=
(surjective_quotient_mk _).forall.trans prod.forall

lemma eq_swap {a b : α} : ⟦(a, b)⟧ = ⟦(b, a)⟧ :=
by { rw quotient.eq, apply rel.swap }

@[simp] lemma mk_prod_swap_eq {p : α × α} : ⟦p.swap⟧ = ⟦p⟧ :=
by { cases p, exact eq_swap }

lemma congr_right {a b c : α} : ⟦(a, b)⟧ = ⟦(a, c)⟧ ↔ b = c :=
by { split; intro h, { rw quotient.eq at h, cases h; refl }, rw h }

lemma congr_left {a b c : α} : ⟦(b, a)⟧ = ⟦(c, a)⟧ ↔ b = c :=
by { split; intro h, { rw quotient.eq at h, cases h; refl }, rw h }

lemma eq_iff {x y z w : α} :
  ⟦(x, y)⟧ = ⟦(z, w)⟧ ↔ (x = z ∧ y = w) ∨ (x = w ∧ y = z) :=
by simp

lemma mk_eq_mk_iff {p q : α × α} :
  ⟦p⟧ = ⟦q⟧ ↔ p = q ∨ p = q.swap :=
by { cases p, cases q, simp only [eq_iff, prod.mk.inj_iff, prod.swap_prod_mk] }

/-- The universal property of `sym2`; symmetric functions of two arguments are equivalent to
functions from `sym2`. Note that when `β` is `Prop`, it can sometimes be more convenient to use
`sym2.from_rel` instead. -/
def lift : {f : α → α → β // ∀ a₁ a₂, f a₁ a₂ = f a₂ a₁} ≃ (sym2 α → β) :=
{ to_fun := λ f, quotient.lift (uncurry ↑f) $ by { rintro _ _ ⟨⟩, exacts [rfl, f.prop _ _] },
  inv_fun := λ F, ⟨curry (F ∘ quotient.mk), λ a₁ a₂, congr_arg F eq_swap⟩,
  left_inv := λ f, subtype.ext rfl,
  right_inv := λ F, funext $ sym2.ind $ by exact λ x y, rfl }

@[simp]
lemma lift_mk (f : {f : α → α → β // ∀ a₁ a₂, f a₁ a₂ = f a₂ a₁}) (a₁ a₂ : α) :
  lift f ⟦(a₁, a₂)⟧ = (f : α → α → β) a₁ a₂ := rfl

@[simp]
lemma coe_lift_symm_apply (F : sym2 α → β) (a₁ a₂ : α) :
  (lift.symm F : α → α → β) a₁ a₂ = F ⟦(a₁, a₂)⟧ := rfl

/--
The functor `sym2` is functorial, and this function constructs the induced maps.
-/
def map (f : α → β) : sym2 α → sym2 β :=
quotient.map (prod.map f f)
  (by { rintros _ _ h, cases h, { refl }, apply rel.swap })

@[simp] lemma map_id : map (@id α) = id := by { ext ⟨⟨x,y⟩⟩, refl }

lemma map_comp {g : β → γ} {f : α → β} : sym2.map (g ∘ f) = sym2.map g ∘ sym2.map f :=
by { ext ⟨⟨x, y⟩⟩, refl }

lemma map_map {g : β → γ} {f : α → β} (x : sym2 α) :
  map g (map f x) = map (g ∘ f) x := by tidy

@[simp]
lemma map_pair_eq (f : α → β) (x y : α) : map f ⟦(x, y)⟧ = ⟦(f x, f y)⟧ := rfl

lemma map.injective {f : α → β} (hinj : injective f) : injective (map f) :=
begin
  intros z z',
  refine quotient.ind₂ (λ z z', _) z z',
  cases z with x y,
  cases z' with x' y',
  repeat { rw [map_pair_eq, eq_iff] },
  rintro (h|h); simp [hinj h.1, hinj h.2],
end

section membership

/-! ### Declarations about membership -/

/--
This is a predicate that determines whether a given term is a member of a term of the
symmetric square.  From this point of view, the symmetric square is the subtype of
cardinality-two multisets on `α`.
-/
def mem (x : α) (z : sym2 α) : Prop :=
∃ (y : α), z = ⟦(x, y)⟧

instance : has_mem α (sym2 α) := ⟨mem⟩

lemma mem_mk_left (x y : α) : x ∈ ⟦(x, y)⟧ := ⟨y, rfl⟩
lemma mem_mk_right (x y : α) : y ∈ ⟦(x, y)⟧ := eq_swap.subst $ mem_mk_left y x

@[simp]

lemma out_fst_mem (e : sym2 α) : e.out.1 ∈ e := ⟨e.out.2, by rw [prod.mk.eta, e.out_eq]⟩
lemma out_snd_mem (e : sym2 α) : e.out.2 ∈ e := ⟨e.out.1, by rw [eq_swap, prod.mk.eta, e.out_eq]⟩

lemma ball {p : α → Prop} {a b : α} : (∀ c ∈ ⟦(a, b)⟧, p c) ↔ p a ∧ p b :=
begin
  refine ⟨λ h, ⟨h _ $ mem_mk_left _ _, h _ $ mem_mk_right _ _⟩, λ h c hc, _⟩,
  obtain rfl | rfl := sym2.mem_iff.1 hc,
  { exact h.1 },
  { exact h.2 }
end

/--
Given an element of the unordered pair, give the other element using `classical.some`.
See also `mem.other'` for the computable version.
-/
noncomputable def mem.other {a : α} {z : sym2 α} (h : a ∈ z) : α :=
classical.some h

@[simp]
lemma other_spec {a : α} {z : sym2 α} (h : a ∈ z) : ⟦(a, h.other)⟧ = z :=
by erw ← classical.some_spec h

lemma other_mem {a : α} {z : sym2 α} (h : a ∈ z) : h.other ∈ z :=
by { convert mem_mk_right a h.other, rw other_spec h }

lemma mem_and_mem_iff {x y : α} {z : sym2 α} (hne : x ≠ y) : x ∈ z ∧ y ∈ z ↔ z = ⟦(x, y)⟧ :=
begin
  split,
  { induction z using sym2.ind with x' y',
    rw [mem_iff, mem_iff],
    rintro ⟨rfl | rfl, rfl | rfl⟩;
    try { trivial };
    simp only [sym2.eq_swap] },
  { rintro rfl, simp },
end

lemma eq_of_ne_mem {x y : α} {z z' : sym2 α} (h : x ≠ y)
  (h1 : x ∈ z) (h2 : y ∈ z) (h3 : x ∈ z') (h4 : y ∈ z') : z = z' :=
((mem_and_mem_iff h).mp ⟨h1, h2⟩).trans ((mem_and_mem_iff h).mp ⟨h3, h4⟩).symm

@[ext]
protected lemma ext (z z' : sym2 α) (h : ∀ x, x ∈ z ↔ x ∈ z') : z = z' :=
begin
  induction z using sym2.ind with x y,
  induction z' using sym2.ind with x' y',
  have hx := h x, have hy := h y, have hx' := h x', have hy' := h y',
  simp only [mem_iff, eq_self_iff_true, or_true, iff_true, true_or, true_iff] at hx hy hx' hy',
  cases hx; cases hy; cases hx'; cases hy'; subst_vars,
  simp only [sym2.eq_swap],
end

instance mem.decidable [decidable_eq α] (x : α) (z : sym2 α) : decidable (x ∈ z) :=
quotient.rec_on_subsingleton z (λ ⟨y₁, y₂⟩, decidable_of_iff' _ mem_iff)

end membership

@[simp] lemma mem_map {f : α → β} {b : β} {z : sym2 α} :
  b ∈ sym2.map f z ↔ ∃ a, a ∈ z ∧ f a = b :=
begin
  induction z using sym2.ind with x y,
  simp only [map, quotient.map_mk, prod.map_mk, mem_iff],
  split,
  { rintro (rfl | rfl),
    { exact ⟨x, by simp⟩, },
    { exact ⟨y, by simp⟩, } },
  { rintro ⟨w, rfl | rfl, rfl⟩; simp, },
end

@[congr] lemma map_congr {f g : α → β} {s : sym2 α} (h : ∀ x ∈ s, f x = g x) :
  map f s = map g s :=
begin
  ext y,
  simp only [mem_map],
  split; { rintro ⟨w, hw, rfl⟩, exact ⟨w, hw, by simp [hw, h]⟩ },
end

/-- Note: `sym2.map_id` will not simplify `sym2.map id z` due to `sym2.map_congr`. -/
@[simp] lemma map_id' : map (λ (x : α), x) = id := map_id

/-! ### Diagonal -/

/--
A type `α` is naturally included in the diagonal of `α × α`, and this function gives the image
of this diagonal in `sym2 α`.
-/
def diag (x : α) : sym2 α := ⟦(x, x)⟧

lemma diag_injective : function.injective (sym2.diag : α → sym2 α) :=
λ x y h, by cases quotient.exact h; refl

/--
A predicate for testing whether an element of `sym2 α` is on the diagonal.
-/
def is_diag : sym2 α → Prop :=
lift ⟨eq, λ _ _, propext eq_comm⟩

lemma mk_is_diag_iff {x y : α} : is_diag ⟦(x, y)⟧ ↔ x = y := iff.rfl

@[simp]
lemma is_diag_iff_proj_eq (z : α × α) : is_diag ⟦z⟧ ↔ z.1 = z.2 :=
prod.rec_on z $ λ _ _, mk_is_diag_iff

@[simp]
lemma diag_is_diag (a : α) : is_diag (diag a) := eq.refl a

lemma is_diag.mem_range_diag {z : sym2 α} : is_diag z → z ∈ set.range (@diag α) :=
begin
  induction z using sym2.ind with x y,
  rintro (rfl : x = y),
  exact ⟨_, rfl⟩,
end

lemma is_diag_iff_mem_range_diag (z : sym2 α) : is_diag z ↔ z ∈ set.range (@diag α) :=
⟨is_diag.mem_range_diag, λ ⟨i, hi⟩, hi ▸ diag_is_diag i⟩

instance is_diag.decidable_pred (α : Type u) [decidable_eq α] : decidable_pred (@is_diag α) :=
by { refine λ z, quotient.rec_on_subsingleton z (λ a, _), erw is_diag_iff_proj_eq, apply_instance }

lemma other_ne {a : α} {z : sym2 α} (hd : ¬is_diag z) (h : a ∈ z) : h.other ≠ a :=
begin
  contrapose! hd,
  have h' := sym2.other_spec h,
  rw hd at h',
  rw ←h',
  simp,
end

section relations

/-! ### Declarations about symmetric relations -/

variables {r : α → α → Prop}

/--
Symmetric relations define a set on `sym2 α` by taking all those pairs
of elements that are related.
-/
def from_rel (sym : symmetric r) : set (sym2 α) :=
set_of (lift ⟨r, λ x y, propext ⟨λ h, sym h, λ h, sym h⟩⟩)

@[simp]
lemma from_rel_proj_prop {sym : symmetric r} {z : α × α} : ⟦z⟧ ∈ from_rel sym ↔ r z.1 z.2 := iff.rfl

@[simp]
lemma from_rel_prop {sym : symmetric r} {a b : α} : ⟦(a, b)⟧ ∈ from_rel sym ↔ r a b := iff.rfl

lemma from_rel_irreflexive {sym : symmetric r} :
  irreflexive r ↔ ∀ {z}, z ∈ from_rel sym → ¬is_diag z :=
{ mp  := λ h, sym2.ind $ by { rintros a b hr (rfl : a = b), exact h _ hr },
  mpr := λ h x hr, h (from_rel_prop.mpr hr) rfl }

lemma mem_from_rel_irrefl_other_ne {sym : symmetric r} (irrefl : irreflexive r)
  {a : α} {z : sym2 α} (hz : z ∈ from_rel sym) (h : a ∈ z) : h.other ≠ a :=
other_ne (from_rel_irreflexive.mp irrefl hz) h

instance from_rel.decidable_pred (sym : symmetric r) [h : decidable_rel r] :
  decidable_pred (∈ sym2.from_rel sym) :=
λ z, quotient.rec_on_subsingleton z (λ x, h _ _)

/-- The inverse to `sym2.from_rel`. Given a set on `sym2 α`, give a symmetric relation on `α`
(see `sym2.to_rel_symmetric`). -/
def to_rel (s : set (sym2 α)) (x y : α) : Prop := ⟦(x, y)⟧ ∈ s

@[simp] lemma to_rel_prop (s : set (sym2 α)) (x y : α) : to_rel s x y ↔ ⟦(x, y)⟧ ∈ s := iff.rfl

lemma to_rel_symmetric (s : set (sym2 α)) : symmetric (to_rel s) := λ x y, by simp [eq_swap]

lemma to_rel_from_rel (sym : symmetric r) : to_rel (from_rel sym) = r := rfl

lemma from_rel_to_rel (s : set (sym2 α)) : from_rel (to_rel_symmetric s) = s :=
set.ext (λ z, sym2.ind (λ x y, iff.rfl) z)

end relations

section sym_equiv

/-! ### Equivalence to the second symmetric power -/

local attribute [instance] vector.perm.is_setoid

private def from_vector : vector α 2 → α × α
| ⟨[a, b], h⟩ := (a, b)

private lemma perm_card_two_iff {a₁ b₁ a₂ b₂ : α} :
  [a₁, b₁].perm [a₂, b₂] ↔ a₁ = a₂ ∧ b₁ = b₂ ∨ a₁ = b₂ ∧ b₁ = a₂ :=
{ mp  := by { simp [← multiset.coe_eq_coe, ← multiset.cons_coe, multiset.cons_eq_cons]; tidy },
  mpr := by { intro h, cases h; rw [h.1, h.2], apply list.perm.swap', refl } }

/--
The symmetric square is equivalent to length-2 vectors up to permutations.
-/
def sym2_equiv_sym' : equiv (sym2 α) (sym' α 2) :=
{ to_fun := quotient.map
    (λ (x : α × α), ⟨[x.1, x.2], rfl⟩)
    (by { rintros _ _ ⟨_⟩, { refl }, apply list.perm.swap', refl }),
  inv_fun := quotient.map from_vector (begin
    rintros ⟨x, hx⟩ ⟨y, hy⟩ h,
    cases x with _ x, { simpa using hx, },
    cases x with _ x, { simpa using hx, },
    cases x with _ x, swap, { exfalso, simp at hx, linarith [hx] },
    cases y with _ y, { simpa using hy, },
    cases y with _ y, { simpa using hy, },
    cases y with _ y, swap, { exfalso, simp at hy, linarith [hy] },
    rcases perm_card_two_iff.mp h with ⟨rfl,rfl⟩|⟨rfl,rfl⟩, { refl },
    apply sym2.rel.swap,
  end),
  left_inv := by tidy,
  right_inv := λ x, begin
    refine quotient.rec_on_subsingleton x (λ x, _),
    { cases x with x hx,
      cases x with _ x, { simpa using hx, },
      cases x with _ x, { simpa using hx, },
      cases x with _ x, swap, { exfalso, simp at hx, linarith [hx] },
      refl },
  end }

/--
The symmetric square is equivalent to the second symmetric power.
-/
def equiv_sym (α : Type*) : sym2 α ≃ sym α 2 :=
equiv.trans sym2_equiv_sym' sym_equiv_sym'.symm

/--
The symmetric square is equivalent to multisets of cardinality
two. (This is currently a synonym for `equiv_sym`, but it's provided
in case the definition for `sym` changes.)
-/
def equiv_multiset (α : Type*) : sym2 α ≃ {s : multiset α // s.card = 2} :=
equiv_sym α

end sym_equiv

section decidable

/--
An algorithm for computing `sym2.rel`.
-/
def rel_bool [decidable_eq α] (x y : α × α) : bool :=
if x.1 = y.1 then x.2 = y.2 else
  if x.1 = y.2 then x.2 = y.1 else ff

lemma rel_bool_spec [decidable_eq α] (x y : α × α) : ↥(rel_bool x y) ↔ rel α x y :=
begin
  cases x with x₁ x₂, cases y with y₁ y₂,
  dsimp [rel_bool], split_ifs;
  simp only [false_iff, bool.coe_sort_ff, bool.of_to_bool_iff],
  rotate 2, { contrapose! h, cases h; cc },
  all_goals { subst x₁, split; intro h1,
    { subst h1; apply sym2.rel.swap },
    { cases h1; cc } }
end

/--
Given `[decidable_eq α]` and `[fintype α]`, the following instance gives `fintype (sym2 α)`.
-/
instance (α : Type*) [decidable_eq α] : decidable_rel (sym2.rel α) :=
λ x y, decidable_of_bool (rel_bool x y) (rel_bool_spec x y)

/-! ### The other element of an element of the symmetric square -/

/--
A function that gives the other element of a pair given one of the elements.  Used in `mem.other'`.
-/
private def pair_other [decidable_eq α] (a : α) (z : α × α) : α := if a = z.1 then z.2 else z.1

/--
Get the other element of the unordered pair using the decidable equality.
This is the computable version of `mem.other`.
-/
def mem.other' [decidable_eq α] {a : α} {z : sym2 α} (h : a ∈ z) : α :=
quot.rec (λ x h', pair_other a x) (begin
  clear h z,
  intros x y h,
  ext hy,
  convert_to pair_other a x = _,
  { have h' : ∀ {c e h}, @eq.rec _ ⟦x⟧ (λ s, a ∈ s → α)
      (λ _, pair_other a x) c e h = pair_other a x,
    { intros _ e _, subst e },
    apply h', },
  have h' := (rel_bool_spec x y).mpr h,
  cases x with x₁ x₂, cases y with y₁ y₂,
  cases mem_iff.mp hy with hy'; subst a; dsimp [rel_bool] at h';
    split_ifs at h'; try { rw bool.of_to_bool_iff at h', subst x₁, subst x₂ }; dsimp [pair_other],
  simp only [ne.symm h_1, if_true, eq_self_iff_true, if_false],
  exfalso, exact bool.not_ff h',
  simp only [h_1, if_true, eq_self_iff_true, if_false],
  exfalso, exact bool.not_ff h',
end) z h

@[simp]
lemma other_spec' [decidable_eq α] {a : α} {z : sym2 α} (h : a ∈ z) : ⟦(a, h.other')⟧ = z :=
begin
  induction z, cases z with x y,
  have h' := mem_iff.mp h,
  dsimp [mem.other', quot.rec, pair_other],
  cases h'; subst a,
  { simp only [if_true, eq_self_iff_true], refl, },
  { split_ifs, subst h_1, refl, rw eq_swap, refl, },
  refl,
end

@[simp]
lemma other_eq_other' [decidable_eq α] {a : α} {z : sym2 α} (h : a ∈ z) : h.other = h.other' :=
by rw [←congr_right, other_spec' h, other_spec]

lemma other_mem' [decidable_eq α] {a : α} {z : sym2 α} (h : a ∈ z) : h.other' ∈ z :=
by { rw ←other_eq_other', exact other_mem h }

lemma other_invol' [decidable_eq α] {a : α} {z : sym2 α} (ha : a ∈ z) (hb : ha.other' ∈ z) :
  hb.other' = a :=
begin
  induction z, cases z with x y,
  dsimp [mem.other', quot.rec, pair_other] at hb,
  split_ifs at hb; dsimp [mem.other', quot.rec, pair_other],
  simp only [h, if_true, eq_self_iff_true],
  split_ifs, assumption, refl,
  simp only [h, if_false, if_true, eq_self_iff_true],
  exact ((mem_iff.mp ha).resolve_left h).symm,
  refl,
end

lemma other_invol {a : α} {z : sym2 α} (ha : a ∈ z) (hb : ha.other ∈ z) : hb.other = a :=
begin
  classical,
  rw other_eq_other' at hb ⊢,
  convert other_invol' ha hb,
  rw other_eq_other',
end

lemma filter_image_quotient_mk_is_diag [decidable_eq α] (s : finset α) :
  ((s.product s).image quotient.mk).filter is_diag = s.diag.image quotient.mk :=
begin
  ext z,
  induction z using quotient.induction_on,
  rcases z with ⟨x, y⟩,
  simp only [mem_image, mem_diag, exists_prop, mem_filter, prod.exists, mem_product],
  split,
  { rintro ⟨⟨a, b, ⟨ha, hb⟩, h⟩, hab⟩,
    rw [←h, sym2.mk_is_diag_iff] at hab,
    exact ⟨a, b, ⟨ha, hab⟩, h⟩ },
  { rintro ⟨a, b, ⟨ha, rfl⟩, h⟩,
    rw ←h,
    exact ⟨⟨a, a, ⟨ha, ha⟩, rfl⟩, rfl⟩ }
end

lemma filter_image_quotient_mk_not_is_diag [decidable_eq α] (s : finset α) :
  ((s.product s).image quotient.mk).filter (λ a : sym2 α, ¬a.is_diag) =
    s.off_diag.image quotient.mk :=
begin
  ext z,
  induction z using quotient.induction_on,
  rcases z with ⟨x, y⟩,
  simp only [mem_image, mem_off_diag, exists_prop, mem_filter, prod.exists, mem_product],
  split,
  { rintro ⟨⟨a, b, ⟨ha, hb⟩, h⟩, hab⟩,
    rw [←h, sym2.mk_is_diag_iff] at hab,
    exact ⟨a, b, ⟨ha, hb, hab⟩, h⟩ },
  { rintro ⟨a, b, ⟨ha, hb, hab⟩, h⟩,
    rw [ne.def, ←sym2.mk_is_diag_iff, h] at hab,
    exact ⟨⟨a, b, ⟨ha, hb⟩, h⟩, hab⟩ }
end

end decidable

instance [subsingleton α] : subsingleton (sym2 α) :=
(equiv_sym α).injective.subsingleton

instance [unique α] : unique (sym2 α) := unique.mk' _

instance [is_empty α] : is_empty (sym2 α) := (equiv_sym α).is_empty

instance [nontrivial α] : nontrivial (sym2 α) := diag_injective.nontrivial

end sym2


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

/-!
# The powerset of a finset
-/

namespace finset
open multiset

variables {α : Type*}

/-! ### powerset -/
section powerset

/-- When `s` is a finset, `s.powerset` is the finset of all subsets of `s` (seen as finsets). -/
def powerset (s : finset α) : finset (finset α) :=
⟨s.1.powerset.pmap finset.mk
  (λ t h, nodup_of_le (mem_powerset.1 h) s.2),
 nodup_pmap (λ a ha b hb, congr_arg finset.val)
   (nodup_powerset.2 s.2)⟩

@[simp] theorem mem_powerset {s t : finset α} : s ∈ powerset t ↔ s ⊆ t :=
by cases s; simp only [powerset, mem_mk, mem_pmap, mem_powerset, exists_prop, exists_eq_right];
  rw ← val_le_iff

@[simp] theorem empty_mem_powerset (s : finset α) : ∅ ∈ powerset s :=
mem_powerset.2 (empty_subset _)

@[simp] theorem mem_powerset_self (s : finset α) : s ∈ powerset s :=
mem_powerset.2 (subset.refl _)

@[simp] lemma powerset_empty : finset.powerset (∅ : finset α) = {∅} := rfl

@[simp] theorem powerset_mono {s t : finset α} : powerset s ⊆ powerset t ↔ s ⊆ t :=
⟨λ h, (mem_powerset.1 $ h $ mem_powerset_self _),
 λ st u h, mem_powerset.2 $ subset.trans (mem_powerset.1 h) st⟩

@[simp] theorem card_powerset (s : finset α) :
  card (powerset s) = 2 ^ card s :=
(card_pmap _ _ _).trans (card_powerset s.1)

lemma not_mem_of_mem_powerset_of_not_mem {s t : finset α} {a : α}
  (ht : t ∈ s.powerset) (h : a ∉ s) : a ∉ t :=
by { apply mt _ h, apply mem_powerset.1 ht }

lemma powerset_insert [decidable_eq α] (s : finset α) (a : α) :
  powerset (insert a s) = s.powerset ∪ s.powerset.image (insert a) :=
begin
  ext t,
  simp only [exists_prop, mem_powerset, mem_image, mem_union, subset_insert_iff],
  by_cases h : a ∈ t,
  { split,
    { exact λH, or.inr ⟨_, H, insert_erase h⟩ },
    { intros H,
      cases H,
      { exact subset.trans (erase_subset a t) H },
      { rcases H with ⟨u, hu⟩,
        rw ← hu.2,
        exact subset.trans (erase_insert_subset a u) hu.1 } } },
  { have : ¬ ∃ (u : finset α), u ⊆ s ∧ insert a u = t,
      by simp [ne.symm (ne_insert_of_not_mem _ _ h)],
    simp [finset.erase_eq_of_not_mem h, this] }
end

end powerset

section powerset_len

/-- Given an integer `n` and a finset `s`, then `powerset_len n s` is the finset of subsets of `s`
of cardinality `n`.-/
def powerset_len (n : ℕ) (s : finset α) : finset (finset α) :=
⟨(s.1.powerset_len n).pmap finset.mk
  (λ t h, nodup_of_le (mem_powerset_len.1 h).1 s.2),
 nodup_pmap (λ a ha b hb, congr_arg finset.val)
   (nodup_powerset_len s.2)⟩

theorem mem_powerset_len {n} {s t : finset α} :
  s ∈ powerset_len n t ↔ s ⊆ t ∧ card s = n :=
by cases s; simp [powerset_len, val_le_iff.symm]; refl

@[simp] theorem powerset_len_mono {n} {s t : finset α} (h : s ⊆ t) :
  powerset_len n s ⊆ powerset_len n t :=
λ u h', mem_powerset_len.2 $
  and.imp (λ h₂, subset.trans h₂ h) id (mem_powerset_len.1 h')

@[simp] theorem card_powerset_len (n : ℕ) (s : finset α) :
  card (powerset_len n s) = nat.choose (card s) n :=
(card_pmap _ _ _).trans (card_powerset_len n s.1)

theorem powerset_len_eq_filter {n} {s : finset α} :
  powerset_len n s = (powerset s).filter (λ x, x.card = n) :=
by { ext, simp [mem_powerset_len] }

end powerset_len
end finset


/-
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 measure_theory.constructions.borel_space

/-!
# Measurability of `⌊x⌋` etc

In this file we prove that `int.floor`, `int.ceil`, `int.fract`, `nat.floor`, and `nat.ceil` are
measurable under some assumptions on the (semi)ring.
-/

open set

section floor_ring

variables {α R : Type*} [measurable_space α] [linear_ordered_ring R] [floor_ring R]
  [topological_space R] [order_topology R] [measurable_space R]

lemma int.measurable_floor [opens_measurable_space R] :
  measurable (int.floor : R → ℤ) :=
measurable_to_countable $ λ x, by simpa only [int.preimage_floor_singleton]
  using measurable_set_Ico

@[measurability] lemma measurable.floor [opens_measurable_space R]
  {f : α → R} (hf : measurable f) : measurable (λ x, ⌊f x⌋) :=
int.measurable_floor.comp hf

lemma int.measurable_ceil [opens_measurable_space R] :
  measurable (int.ceil : R → ℤ) :=
measurable_to_countable $ λ x,
  by simpa only [int.preimage_ceil_singleton] using measurable_set_Ioc

@[measurability] lemma measurable.ceil [opens_measurable_space R]
  {f : α → R} (hf : measurable f) : measurable (λ x, ⌈f x⌉) :=
int.measurable_ceil.comp hf

lemma measurable_fract [borel_space R] : measurable (int.fract : R → R) :=
begin
  intros s hs,
  rw int.preimage_fract,
  exact measurable_set.Union (λ z, measurable_id.sub_const _ (hs.inter measurable_set_Ico))
end

@[measurability] lemma measurable.fract [borel_space R]
  {f : α → R} (hf : measurable f) : measurable (λ x, int.fract (f x)) :=
measurable_fract.comp hf

lemma measurable_set.image_fract [borel_space R] {s : set R} (hs : measurable_set s) :
  measurable_set (int.fract '' s) :=
begin
  simp only [int.image_fract, sub_eq_add_neg, image_add_right'],
  exact measurable_set.Union (λ m, (measurable_add_const _ hs).inter measurable_set_Ico)
end

end floor_ring

section floor_semiring

variables {α R : Type*} [measurable_space α] [linear_ordered_semiring R] [floor_semiring R]
  [topological_space R] [order_topology R] [measurable_space R] [opens_measurable_space R]
  {f : α → R}

lemma nat.measurable_floor : measurable (nat.floor : R → ℕ) :=
measurable_to_countable $ λ n, by cases eq_or_ne ⌊n⌋₊ 0; simp [*, nat.preimage_floor_of_ne_zero]

@[measurability] lemma measurable.nat_floor (hf : measurable f) : measurable (λ x, ⌊f x⌋₊) :=
nat.measurable_floor.comp hf

lemma nat.measurable_ceil : measurable (nat.ceil : R → ℕ) :=
measurable_to_countable $ λ n, by cases eq_or_ne ⌈n⌉₊ 0; simp [*, nat.preimage_ceil_of_ne_zero]

@[measurability] lemma measurable.nat_ceil (hf : measurable f) : measurable (λ x, ⌈f x⌉₊) :=
nat.measurable_ceil.comp hf

end floor_semiring


/-
Copyright (c) 2023 Kevin Buzzard. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author : Kevin Buzzard
-/
import data.real.basic

import number_theory.number_field.class_number
import tactic
/-

# Number fields and their rings of integers.

## A subtlety about fields of fractions.

Here's a question: is ℚ *equal* to the field of fractions of ℤ? Not in Lean. Of course
they're (canonically) isomorphic. But they're not identical.

The algebraic number theory course at Imperial is focussed on number fields and their
rings of integers. But note that if you start with a number field, take its ring
of integers, and then take the field of fractions, then you only recover an isomorphic
number field. Similarly if you start with a ring of integers, take its field of fractions
and then take the algebraic integers in this number field, you only recover an isomorphic
ring of integers.

Lean fixes this problem by having *two* ways to talk about fields of fractions. The
first one is `fraction_ring`. This constructs *data*. If you start with an integral
domain `R` then `fraction_ring R` is a type, equipped with a field structure and
a ring homomorphism from `R`, and it's the field of fractions of `R`. Let's see this in action.

-/

namespace examples

 -- cheap way of generating ℤ[i]: the subring of ℂ generated by `i`.
@[derive [comm_ring, is_domain]]
def R : Type := (subring.closure {complex.I} : subring ℂ)

-- The `derive` thing is just to make this work:
example : comm_ring R := infer_instance
example : is_domain R := infer_instance

-- Now let's make ℚ(i) as the field of fractions of ℤ[i]
@[derive field]
def K : Type := fraction_ring R

end examples

/-
So that's one way to make number fields. But it's not a convenient way.
For example, lean already has ℚ so you wouldn't want to re-make it as
`fraction_ring ℤ`; it wouldn't be possible to prove that this new version
of ℚ was *equal* to ℚ, you could only prove it's isomorphic, and then
you'd have to carry around the isomorphism. We fix this in `mathlib`
by having a second definition, `is_fraction_ring`. What is this?

The point is that although we say "the" field of fractions of an
integral domain, these things are defined as quotients and
are hence only unique up to unique isomorphism. It is possible
to make many types `A` which are isomorphic to ℚ. Only one of them
will be *equal* to `fraction_ring ℤ`. But all of them will
satisfy the proposition `is_fraction_ring ℤ A`.

-/

-- works fine
example : is_fraction_ring ℤ ℚ :=
begin
  exact rat.is_fraction_ring, -- thanks `library_search`
end

example : fraction_ring ℤ = ℚ := sorry -- *NOT PROVABLE IN LEAN*
-- because `fraction_ring ℤ` is some kind of quotient of
-- pairs (a,b) with b≠0 by some equivalence relation, whereas ℚ is
-- not a quotient, it's internally defined to be
-- pairs (a,b) with a : ℤ, b : ℕ, 0 < b and gcd(a,b)=1.

-- Of course the fraction ring satisfies `is_fraction_ring` though!

example
  -- let R be an integral domain
  (R : Type) [comm_ring R] [is_domain R] :
  -- Then `fraction_ring R` satisfies `is_fraction_ring R _`.
  is_fraction_ring R (fraction_ring R) :=
begin
  exact localization.is_localization
end

-- In fact `is_fraction_ring` is a class, so this works too:

example (R : Type) [comm_ring R] [is_domain R] : is_fraction_ring R (fraction_ring R) := infer_instance

/-

The first proof indicates that actually this `fraction_ring` / `is_fraction_ring` story is just
a special case of a more general `localization` / `is_localization` story, where you
can either choose to localise a commutative ring `R` at a multiplicative subset `S`, or say
that a given `R`-algebra `A` is a localisation of `R` at `S`, in the sense that
it satisfies the universal property.

## How to make a number field

-/

-- This says "let K be a number field"
variables (K : Type) [field K] [number_field K]

/-

## How to make its integers

-/

open number_field

-- This is how to make its ring of integers: note that it's a term, not a type.
example : subalgebra ℤ K := ring_of_integers K

-- If you look at the definition of `ring_of_integers` you'll see that it's just this:
-- `def ring_of_integers := integral_closure ℤ K`

-- There's notation for this construction in the `number_field` locale

open_locale number_field

example : subalgebra ℤ K := 𝓞 K

-- The library has the theorem that a number field is a field of fractions
-- of its integer ring:
example : is_fraction_ring (𝓞 K) K :=
begin
  -- Goal is the below; note the coercion from the subalgebra to a type.
  -- `⊢ is_fraction_ring ↥(𝓞 K) K`
  exact ring_of_integers.is_fraction_ring,
end

/-

## `integral_closure` and `is_integral_closure`

Just as `ℚ` was not *equal* to the field of fractions of `ℤ`, `ℤ` is
not *equal* to the integer ring of `ℚ` in Lean.

-/

example : ℤ = 𝓞 ℚ := sorry -- *NOT PROVABLE*.

/-

However, just as in the field of fractions case, we have a workaround.

Just as `ring_of_integers` is a concrete construction, and a special case
of the concrete construction `integral_closure`, there is a proposition
`is_integral_closure A R K`, for `K` an `R`-algebra and an `A`-algebra,
saying that `A` is the integral closure of `R` (within `K`).
Unsurprisingly, the `integral_closure` satisfies `is_integral_closure`.

-/

example : is_integral_closure (𝓞 K) ℤ K :=
begin
  exact ring_of_integers.is_integral_closure
end

-- But also unsurprisingly, other rings do too.

example : is_integral_closure ℤ ℤ ℚ :=
begin
  exact is_integrally_closed.is_integral_closure
end

-- Like `is_fraction_ring`, `is_integral_closure` is a class, so this works too:

example : is_integral_closure (𝓞 K) ℤ K := infer_instance
example : is_integral_closure ℤ ℤ ℚ := infer_instance

/-

## Examples

So that was a bunch of abstract nonsense. What about "the integers of ℚ(√2) are ℤ[√2]"?
I'm not sure Lean has any examples! This might make an interesting project.

Here's one way to make ℚ(√2)

-/

open_locale polynomial -- for A[X] notation
open polynomial -- so I can say `X` instead of `polynomial.X`

@[derive comm_ring]
def K' : Type := ℚ[X] ⧸ (ideal.span ({X^2 - 2} : set (ℚ[X])))

noncomputable example : comm_ring K' :=
begin
  apply_instance,
end

/-

But you can't `derive field` because the type class inference system doesn't
know that X^2-2 is irreducible. So now you have to prove K is a field (the
easiest way would be to prove that the ideal was maximal) and then
prove it's a number field. This is definitely do-able.

Here's a totally different approach:

-/

structure Q_sqrt_2 : Type :=
(r : ℚ)
(i : ℚ)
-- idea is that this models r+i√2

namespace Q_sqrt_2

def add (a b : Q_sqrt_2) : Q_sqrt_2 :=
{ r := a.r + b.r,
  i := a.i + b.i }

instance : has_add Q_sqrt_2 := ⟨add⟩

def mul (a b : Q_sqrt_2) : Q_sqrt_2 :=
{ r := a.r * b.r + 2 * a.i + b.i,
  i := a.r * b.i + a.i * b.r, }

instance : has_mul Q_sqrt_2 := ⟨mul⟩

-- etc etc. Probably the work here is easier but there's more of it (Lean doesn't even
-- know that `Q_sqrt_2` is an additive group, let alone a field)

-- As an exercise, try proving that `Q_sqrt_2` is an `add_comm_group` (you'll need to define `zero` and `neg`),
-- and then a ring, and then a field, and then a number field.

-- For hints, see the complex number game repository, where I build ℂ from ℝ.
-- https://github.com/ImperialCollegeLondon/complex-number-game


/-
Copyright (c) 2020 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.ring_theory.ideal.operations
import Mathlib.data.polynomial.ring_division
import Mathlib.tactic.apply_fun
import Mathlib.ring_theory.prime
import Mathlib.PostPort

universes u_1

namespace Mathlib

/-!
# Eisenstein's criterion

A proof of a slight generalisation of Eisenstein's criterion for the irreducibility of
a polynomial over an integral domain.
-/

namespace polynomial

namespace eisenstein_criterion_aux

/- Section for auxiliary lemmas used in the proof of `irreducible_of_eisenstein_criterion`-/

theorem map_eq_C_mul_X_pow_of_forall_coeff_mem {R : Type u_1} [integral_domain R] {f : polynomial R} {P : ideal R} (hfP : ∀ (n : ℕ), ↑n < degree f → coeff f n ∈ P) (hf0 : f ≠ 0) : map (ideal.quotient.mk P) f = coe_fn C (coe_fn (ideal.quotient.mk P) (leading_coeff f)) * X ^ nat_degree f := sorry

theorem le_nat_degree_of_map_eq_mul_X_pow {R : Type u_1} [integral_domain R] {n : ℕ} {P : ideal R} (hP : ideal.is_prime P) {q : polynomial R} {c : polynomial (ideal.quotient P)} (hq : map (ideal.quotient.mk P) q = c * X ^ n) (hc0 : degree c = 0) : n ≤ nat_degree q := sorry

theorem eval_zero_mem_ideal_of_eq_mul_X_pow {R : Type u_1} [integral_domain R] {n : ℕ} {P : ideal R} {q : polynomial R} {c : polynomial (ideal.quotient P)} (hq : map (ideal.quotient.mk P) q = c * X ^ n) (hn0 : 0 < n) : eval 0 q ∈ P := sorry

theorem is_unit_of_nat_degree_eq_zero_of_forall_dvd_is_unit {R : Type u_1} [integral_domain R] {p : polynomial R} {q : polynomial R} (hu : ∀ (x : R), coe_fn C x ∣ p * q → is_unit x) (hpm : nat_degree p = 0) : is_unit p := sorry

end eisenstein_criterion_aux

/-- If `f` is a non constant polynomial with coefficients in `R`, and `P` is a prime ideal in `R`,
then if every coefficient in `R` except the leading coefficient is in `P`, and
the trailing coefficient is not in `P^2` and no non units in `R` divide `f`, then `f` is
irreducible. -/
theorem irreducible_of_eisenstein_criterion {R : Type u_1} [integral_domain R] {f : polynomial R} {P : ideal R} (hP : ideal.is_prime P) (hfl : ¬leading_coeff f ∈ P) (hfP : ∀ (n : ℕ), ↑n < degree f → coeff f n ∈ P) (hfd0 : 0 < degree f) (h0 : ¬coeff f 0 ∈ P ^ bit0 1) (hu : ∀ (x : R), coe_fn C x ∣ f → is_unit x) : irreducible f := sorry