/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro, Johannes Hölzl, Patrick Massot
-/
import data.set.basic

/-!
# Sets in product and pi types

This file defines the product of sets in `α × β` and in `Π i, α i` along with the diagonal of a
type.

## Main declarations

* `set.prod`: Binary product of sets. For `s : set α`, `t : set β`, we have
  `s.prod t : set (α × β)`.
* `set.diagonal`: Diagonal of a type. `set.diagonal α = {(x, x) | x : α}`.
* `set.pi`: Arbitrary product of sets.
-/

open function

/-- Notation class for product of subobjects (sets, submonoids, subgroups, etc). -/
class has_set_prod (α β : Type*) (γ : out_param Type*) :=
(prod : α → β → γ)

infix ` ×ˢ `:72 := has_set_prod.prod

namespace set

/-! ### Cartesian binary product of sets -/

section prod
variables {α β γ δ : Type*} {s s₁ s₂ : set α} {t t₁ t₂ : set β} {a : α} {b : β}

/-- The cartesian product `prod s t` is the set of `(a, b)`
  such that `a ∈ s` and `b ∈ t`. -/
instance : has_set_prod (set α) (set β) (set (α × β)) :=
⟨λ s t, {p | p.1 ∈ s ∧ p.2 ∈ t}⟩

lemma prod_eq (s : set α) (t : set β) : s ×ˢ t = prod.fst ⁻¹' s ∩ prod.snd ⁻¹' t := rfl

lemma mem_prod_eq {p : α × β} : p ∈ s ×ˢ t = (p.1 ∈ s ∧ p.2 ∈ t) := rfl

@[simp] lemma mem_prod {p : α × β} : p ∈ s ×ˢ t ↔ p.1 ∈ s ∧ p.2 ∈ t := iff.rfl

@[simp] lemma prod_mk_mem_set_prod_eq : (a, b) ∈ s ×ˢ t = (a ∈ s ∧ b ∈ t) := rfl

lemma mk_mem_prod (ha : a ∈ s) (hb : b ∈ t) : (a, b) ∈ s ×ˢ t := ⟨ha, hb⟩

lemma prod_mono (hs : s₁ ⊆ s₂) (ht : t₁ ⊆ t₂) : s₁ ×ˢ t₁ ⊆ s₂ ×ˢ t₂ :=
λ x ⟨h₁, h₂⟩, ⟨hs h₁, ht h₂⟩

lemma prod_subset_iff {P : set (α × β)} : (s ×ˢ t ⊆ P) ↔ ∀ (x ∈ s) (y ∈ t), (x, y) ∈ P :=
⟨λ h _ hx _ hy, h (mk_mem_prod hx hy), λ h ⟨_, _⟩ hp, h _ hp.1 _ hp.2⟩

lemma forall_prod_set {p : α × β → Prop} : (∀ x ∈ s ×ˢ t, p x) ↔ ∀ (x ∈ s) (y ∈ t), p (x, y) :=
prod_subset_iff

lemma exists_prod_set {p : α × β → Prop} : (∃ x ∈ s ×ˢ t, p x) ↔ ∃ (x ∈ s) (y ∈ t), p (x, y) :=
by simp [and_assoc]

@[simp] lemma prod_empty : s ×ˢ (∅ : set β) = ∅ := by { ext, exact and_false _ }

@[simp] lemma empty_prod : (∅ : set α) ×ˢ t = ∅ := by { ext, exact false_and _ }

@[simp] lemma univ_prod_univ : @univ α ×ˢ @univ β = univ := by { ext, exact true_and _ }

lemma univ_prod {t : set β} : (univ : set α) ×ˢ t = prod.snd ⁻¹' t := by simp [prod_eq]

lemma prod_univ {s : set α} : s ×ˢ (univ : set β) = prod.fst ⁻¹' s := by simp [prod_eq]

@[simp] lemma singleton_prod : ({a} : set α) ×ˢ t = prod.mk a '' t :=
by { ext ⟨x, y⟩, simp [and.left_comm, eq_comm] }

@[simp] lemma prod_singleton : s ×ˢ ({b} : set β) = (λ a, (a, b)) '' s :=
by { ext ⟨x, y⟩, simp [and.left_comm, eq_comm] }

lemma singleton_prod_singleton : ({a} : set α) ×ˢ ({b} : set β) = {(a, b)} :=by simp

@[simp] lemma union_prod : (s₁ ∪ s₂) ×ˢ t = s₁ ×ˢ t ∪ s₂ ×ˢ t :=
by { ext ⟨x, y⟩, simp [or_and_distrib_right] }

@[simp] lemma prod_union : s ×ˢ (t₁ ∪ t₂) = s ×ˢ t₁ ∪ s ×ˢ t₂ :=
by { ext ⟨x, y⟩, simp [and_or_distrib_left] }

lemma prod_inter_prod : s₁ ×ˢ t₁ ∩ s₂ ×ˢ t₂ = (s₁ ∩ s₂) ×ˢ (t₁ ∩ t₂) :=
by { ext ⟨x, y⟩, simp [and_assoc, and.left_comm] }

lemma insert_prod : insert a s ×ˢ t = (prod.mk a '' t) ∪ s ×ˢ t :=
by { ext ⟨x, y⟩, simp [image, iff_def, or_imp_distrib, imp.swap] {contextual := tt} }

lemma prod_insert : s ×ˢ (insert b t) = ((λa, (a, b)) '' s) ∪ s ×ˢ t :=
by { ext ⟨x, y⟩, simp [image, iff_def, or_imp_distrib, imp.swap] {contextual := tt} }

lemma prod_preimage_eq {f : γ → α} {g : δ → β} :
  (f ⁻¹' s) ×ˢ (g ⁻¹' t) = (λ p : γ × δ, (f p.1, g p.2)) ⁻¹' (s ×ˢ t) := rfl

lemma prod_preimage_left {f : γ → α} :
  (f ⁻¹' s) ×ˢ t = (λ p : γ × β, (f p.1, p.2)) ⁻¹' (s ×ˢ t) := rfl

lemma prod_preimage_right {g : δ → β} :
  s ×ˢ (g ⁻¹' t) = (λ p : α × δ, (p.1, g p.2)) ⁻¹' (s ×ˢ t) := rfl

lemma preimage_prod_map_prod (f : α → β) (g : γ → δ) (s : set β) (t : set δ) :
  prod.map f g ⁻¹' (s ×ˢ t) = (f ⁻¹' s) ×ˢ (g ⁻¹' t) :=
rfl

lemma mk_preimage_prod (f : γ → α) (g : γ → β) :
  (λ x, (f x, g x)) ⁻¹' (s ×ˢ t) = f ⁻¹' s ∩ g ⁻¹' t := rfl

@[simp] lemma mk_preimage_prod_left (hb : b ∈ t) : (λ a, (a, b)) ⁻¹' (s ×ˢ t) = s :=
by { ext a, simp [hb] }

@[simp] lemma mk_preimage_prod_right (ha : a ∈ s) : prod.mk a ⁻¹' (s ×ˢ t) = t :=
by { ext b, simp [ha] }

@[simp] lemma mk_preimage_prod_left_eq_empty (hb : b ∉ t) : (λ a, (a, b)) ⁻¹' (s ×ˢ t) = ∅ :=
by { ext a, simp [hb] }

@[simp] lemma mk_preimage_prod_right_eq_empty (ha : a ∉ s) : prod.mk a ⁻¹' (s ×ˢ t) = ∅ :=
by { ext b, simp [ha] }

lemma mk_preimage_prod_left_eq_if [decidable_pred (∈ t)] :
  (λ a, (a, b)) ⁻¹' (s ×ˢ t) = if b ∈ t then s else ∅ :=
by split_ifs; simp [h]

lemma mk_preimage_prod_left_fn_eq_if [decidable_pred (∈ t)] (f : γ → α) :
  (λ a, (f a, b)) ⁻¹' (s ×ˢ t) = if b ∈ t then f ⁻¹' s else ∅ :=
by rw [← mk_preimage_prod_left_eq_if, prod_preimage_left, preimage_preimage]

lemma mk_preimage_prod_right_fn_eq_if [decidable_pred (∈ s)] (g : δ → β) :
  (λ b, (a, g b)) ⁻¹' (s ×ˢ t) = if a ∈ s then g ⁻¹' t else ∅ :=
by rw [← mk_preimage_prod_right_eq_if, prod_preimage_right, preimage_preimage]

lemma preimage_swap_prod {s : set α} {t : set β} : prod.swap ⁻¹' (t ×ˢ s) = s ×ˢ t :=
by { ext ⟨x, y⟩, simp [and_comm] }

lemma image_swap_prod : prod.swap '' (t ×ˢ s) = s ×ˢ t :=
by rw [image_swap_eq_preimage_swap, preimage_swap_prod]

lemma prod_image_image_eq {m₁ : α → γ} {m₂ : β → δ} :
  (m₁ '' s) ×ˢ (m₂ '' t) = image (λ p : α × β, (m₁ p.1, m₂ p.2)) (s ×ˢ t) :=
ext $ by simp [-exists_and_distrib_right, exists_and_distrib_right.symm, and.left_comm,
  and.assoc, and.comm]

lemma prod_range_range_eq {m₁ : α → γ} {m₂ : β → δ} :
  (range m₁) ×ˢ (range m₂) = range (λ p : α × β, (m₁ p.1, m₂ p.2)) :=
ext $ by simp [range]

@[simp] lemma range_prod_map {m₁ : α → γ} {m₂ : β → δ} :
  range (prod.map m₁ m₂) = (range m₁) ×ˢ (range m₂) :=
prod_range_range_eq.symm

lemma prod_range_univ_eq {m₁ : α → γ} :
  (range m₁) ×ˢ (univ : set β) = range (λ p : α × β, (m₁ p.1, p.2)) :=
ext $ by simp [range]

lemma prod_univ_range_eq {m₂ : β → δ} :
  (univ : set α) ×ˢ (range m₂) = range (λ p : α × β, (p.1, m₂ p.2)) :=
ext $ by simp [range]

lemma range_pair_subset (f : α → β) (g : α → γ) :
  range (λ x, (f x, g x)) ⊆ (range f) ×ˢ (range g) :=
have (λ x, (f x, g x)) = prod.map f g ∘ (λ x, (x, x)), from funext (λ x, rfl),
by { rw [this, ← range_prod_map], apply range_comp_subset_range }

lemma nonempty.prod : s.nonempty → t.nonempty → (s ×ˢ t : set _).nonempty :=
λ ⟨x, hx⟩ ⟨y, hy⟩, ⟨(x, y), ⟨hx, hy⟩⟩

lemma nonempty.fst : (s ×ˢ t : set _).nonempty → s.nonempty := λ ⟨x, hx⟩, ⟨x.1, hx.1⟩
lemma nonempty.snd : (s ×ˢ t : set _).nonempty → t.nonempty := λ ⟨x, hx⟩, ⟨x.2, hx.2⟩

lemma prod_nonempty_iff : (s ×ˢ t : set _).nonempty ↔ s.nonempty ∧ t.nonempty :=
⟨λ h, ⟨h.fst, h.snd⟩, λ h, h.1.prod h.2⟩

lemma prod_eq_empty_iff : s ×ˢ t = ∅ ↔ (s = ∅ ∨ t = ∅) :=
by simp only [not_nonempty_iff_eq_empty.symm, prod_nonempty_iff, not_and_distrib]

lemma prod_sub_preimage_iff {W : set γ} {f : α × β → γ} :
  s ×ˢ t ⊆ f ⁻¹' W ↔ ∀ a b, a ∈ s → b ∈ t → f (a, b) ∈ W :=
by simp [subset_def]

lemma fst_image_prod_subset (s : set α) (t : set β) : prod.fst '' (s ×ˢ t) ⊆ s :=
λ _ h, let ⟨_, ⟨h₂, _⟩, h₁⟩ := (set.mem_image _ _ _).1 h in h₁ ▸ h₂

lemma prod_subset_preimage_fst (s : set α) (t : set β) : s ×ˢ t ⊆ prod.fst ⁻¹' s :=
image_subset_iff.1 (fst_image_prod_subset s t)

lemma fst_image_prod (s : set β) {t : set α} (ht : t.nonempty) : prod.fst '' (s ×ˢ t) = s :=
(fst_image_prod_subset _ _).antisymm $ λ y hy, let ⟨x, hx⟩ := ht in ⟨(y, x), ⟨hy, hx⟩, rfl⟩

lemma snd_image_prod_subset (s : set α) (t : set β) : prod.snd '' (s ×ˢ t) ⊆ t :=
λ _ h, let ⟨_, ⟨_, h₂⟩, h₁⟩ := (set.mem_image _ _ _).1 h in h₁ ▸ h₂

lemma prod_subset_preimage_snd (s : set α) (t : set β) : s ×ˢ t ⊆ prod.snd ⁻¹' t :=
image_subset_iff.1 (snd_image_prod_subset s t)

lemma snd_image_prod {s : set α} (hs : s.nonempty) (t : set β) : prod.snd '' (s ×ˢ t) = t :=
(snd_image_prod_subset _ _).antisymm $ λ y y_in, let ⟨x, x_in⟩ := hs in ⟨(x, y), ⟨x_in, y_in⟩, rfl⟩

lemma prod_diff_prod : s ×ˢ t \ s₁ ×ˢ t₁ = s ×ˢ (t \ t₁) ∪ (s \ s₁) ×ˢ t :=
by { ext x, by_cases h₁ : x.1 ∈ s₁; by_cases h₂ : x.2 ∈ t₁; simp * }

/-- A product set is included in a product set if and only factors are included, or a factor of the
first set is empty. -/
lemma prod_subset_prod_iff : s ×ˢ t ⊆ s₁ ×ˢ t₁ ↔ s ⊆ s₁ ∧ t ⊆ t₁ ∨ s = ∅ ∨ t = ∅ :=
begin
  cases (s ×ˢ t : set _).eq_empty_or_nonempty with h h,
  { simp [h, prod_eq_empty_iff.1 h] },
  have st : s.nonempty ∧ t.nonempty, by rwa [prod_nonempty_iff] at h,
  refine ⟨λ H, or.inl ⟨_, _⟩, _⟩,
  { have := image_subset (prod.fst : α × β → α) H,
    rwa [fst_image_prod _ st.2, fst_image_prod _ (h.mono H).snd] at this },
  { have := image_subset (prod.snd : α × β → β) H,
    rwa [snd_image_prod st.1, snd_image_prod (h.mono H).fst] at this },
  { intro H,
    simp only [st.1.ne_empty, st.2.ne_empty, or_false] at H,
    exact prod_mono H.1 H.2 }
end

@[simp] lemma image_prod (f : α → β → γ) : (λ x : α × β, f x.1 x.2) '' (s ×ˢ t) = image2 f s t :=
set.ext $ λ a,
⟨ by { rintro ⟨_, _, rfl⟩, exact ⟨_, _, (mem_prod.mp ‹_›).1, (mem_prod.mp ‹_›).2, rfl⟩ },
  by { rintro ⟨_, _, _, _, rfl⟩, exact ⟨(_, _), mem_prod.mpr ⟨‹_›, ‹_›⟩, rfl⟩ }⟩

end prod

/-! ### Diagonal -/

section diagonal
variables {α : Type*}

/-- `diagonal α` is the set of `α × α` consisting of all pairs of the form `(a, a)`. -/
def diagonal (α : Type*) : set (α × α) := {p | p.1 = p.2}

@[simp] lemma mem_diagonal (x : α) : (x, x) ∈ diagonal α := by simp [diagonal]

lemma preimage_coe_coe_diagonal (s : set α) : (prod.map coe coe) ⁻¹' (diagonal α) = diagonal s :=
by { ext ⟨⟨x, hx⟩, ⟨y, hy⟩⟩, simp [set.diagonal] }

lemma diagonal_eq_range : diagonal α = range (λ x, (x, x)) :=
by { ext ⟨x, y⟩, simp [diagonal, eq_comm] }

end diagonal

/-! ### Cartesian set-indexed product of sets -/

section pi
variables {ι : Type*} {α β : ι → Type*} {s s₁ s₂ : set ι} {t t₁ t₂ : Π i, set (α i)} {i : ι}

/-- Given an index set `ι` and a family of sets `t : Π i, set (α i)`, `pi s t`
is the set of dependent functions `f : Πa, π a` such that `f a` belongs to `t a`
whenever `a ∈ s`. -/
def pi (s : set ι) (t : Π i, set (α i)) : set (Π i, α i) := {f | ∀ i ∈ s, f i ∈ t i}

@[simp] lemma mem_pi {f : Π i, α i} : f ∈ s.pi t ↔ ∀ i ∈ s, f i ∈ t i := iff.rfl

@[simp] lemma mem_univ_pi {f : Π i, α i} : f ∈ pi univ t ↔ ∀ i, f i ∈ t i := by simp

@[simp] lemma empty_pi (s : Π i, set (α i)) : pi ∅ s = univ := by { ext, simp [pi] }

@[simp] lemma pi_univ (s : set ι) : pi s (λ i, (univ : set (α i))) = univ :=
eq_univ_of_forall $ λ f i hi, mem_univ _

lemma pi_mono (h : ∀ i ∈ s, t₁ i ⊆ t₂ i) : pi s t₁ ⊆ pi s t₂ :=
λ x hx i hi, (h i hi $ hx i hi)

lemma pi_inter_distrib : s.pi (λ i, t i ∩ t₁ i) = s.pi t ∩ s.pi t₁ :=
ext $ λ x, by simp only [forall_and_distrib, mem_pi, mem_inter_eq]

lemma pi_congr (h : s₁ = s₂) (h' : ∀ i ∈ s₁, t₁ i = t₂ i) : s₁.pi t₁ = s₂.pi t₂ :=
h ▸ (ext $ λ x, forall₂_congr $ λ i hi, h' i hi ▸ iff.rfl)

lemma pi_eq_empty (hs : i ∈ s) (ht : t i = ∅) : s.pi t = ∅ :=
by { ext f, simp only [mem_empty_eq, not_forall, iff_false, mem_pi, not_imp],
     exact ⟨i, hs, by simp [ht]⟩ }

lemma univ_pi_eq_empty (ht : t i = ∅) : pi univ t = ∅ := pi_eq_empty (mem_univ i) ht

lemma pi_nonempty_iff : (s.pi t).nonempty ↔ ∀ i, ∃ x, i ∈ s → x ∈ t i :=
by simp [classical.skolem, set.nonempty]

lemma univ_pi_nonempty_iff : (pi univ t).nonempty ↔ ∀ i, (t i).nonempty :=
by simp [classical.skolem, set.nonempty]

lemma pi_eq_empty_iff : s.pi t = ∅ ↔ ∃ i, is_empty (α i) ∨ i ∈ s ∧ t i = ∅ :=
begin
  rw [← not_nonempty_iff_eq_empty, pi_nonempty_iff],
  push_neg,
  refine exists_congr (λ i, ⟨λ h, (is_empty_or_nonempty (α i)).imp_right _, _⟩),
  { rintro ⟨x⟩,
    exact ⟨(h x).1, by simp [eq_empty_iff_forall_not_mem, h]⟩ },
  { rintro (h | h) x,
    { exact h.elim' x },
    { simp [h] } }
end

lemma univ_pi_eq_empty_iff : pi univ t = ∅ ↔ ∃ i, t i = ∅ :=
by simp [← not_nonempty_iff_eq_empty, univ_pi_nonempty_iff]

@[simp] lemma univ_pi_empty [h : nonempty ι] : pi univ (λ i, ∅ : Π i, set (α i)) = ∅ :=
univ_pi_eq_empty_iff.2 $ h.elim $ λ x, ⟨x, rfl⟩

@[simp] lemma range_dcomp (f : Π i, α i → β i) :
  range (λ (g : Π i, α i), (λ i, f i (g i))) = pi univ (λ i, range (f i)) :=
begin
  apply subset.antisymm _ (λ x hx, _),
  { rintro _ ⟨x, rfl⟩ i -,
    exact ⟨x i, rfl⟩ },
  { choose y hy using hx,
    exact ⟨λ i, y i trivial, funext $ λ i, hy i trivial⟩ }
end

@[simp] lemma insert_pi (i : ι) (s : set ι) (t : Π i, set (α i)) :
  pi (insert i s) t = (eval i ⁻¹' t i) ∩ pi s t :=
by { ext, simp [pi, or_imp_distrib, forall_and_distrib] }

@[simp] lemma singleton_pi (i : ι) (t : Π i, set (α i)) : pi {i} t = (eval i ⁻¹' t i) :=
by { ext, simp [pi] }

lemma singleton_pi' (i : ι) (t : Π i, set (α i)) : pi {i} t = {x | x i ∈ t i} := singleton_pi i t

lemma pi_if {p : ι → Prop} [h : decidable_pred p] (s : set ι) (t₁ t₂ : Π i, set (α i)) :
  pi s (λ i, if p i then t₁ i else t₂ i) = pi {i ∈ s | p i} t₁ ∩ pi {i ∈ s | ¬ p i} t₂ :=
begin
  ext f,
  refine ⟨λ h, _, _⟩,
  { split; { rintro i ⟨his, hpi⟩, simpa [*] using h i } },
  { rintro ⟨ht₁, ht₂⟩ i his,
    by_cases p i; simp * at * }
end

lemma union_pi : (s₁ ∪ s₂).pi t = s₁.pi t ∩ s₂.pi t :=
by simp [pi, or_imp_distrib, forall_and_distrib, set_of_and]

@[simp] lemma pi_inter_compl (s : set ι) : pi s t ∩ pi sᶜ t = pi univ t :=
by rw [← union_pi, union_compl_self]

lemma pi_update_of_not_mem [decidable_eq ι] (hi : i ∉ s) (f : Π j, α j) (a : α i)
  (t : Π j, α j → set (β j)) :
  s.pi (λ j, t j (update f i a j)) = s.pi (λ j, t j (f j)) :=
pi_congr rfl $ λ j hj, by { rw update_noteq, exact λ h, hi (h ▸ hj) }

lemma pi_update_of_mem [decidable_eq ι] (hi : i ∈ s) (f : Π j, α j) (a : α i)
  (t : Π j, α j → set (β j)) :
  s.pi (λ j, t j (update f i a j)) = {x | x i ∈ t i a} ∩ (s \ {i}).pi (λ j, t j (f j)) :=
calc s.pi (λ j, t j (update f i a j)) = ({i} ∪ s \ {i}).pi (λ j, t j (update f i a j)) :
  by rw [union_diff_self, union_eq_self_of_subset_left (singleton_subset_iff.2 hi)]
... = {x | x i ∈ t i a} ∩ (s \ {i}).pi (λ j, t j (f j)) :
  by { rw [union_pi, singleton_pi', update_same, pi_update_of_not_mem], simp }

lemma univ_pi_update [decidable_eq ι] {β : Π i, Type*} (i : ι) (f : Π j, α j) (a : α i)
  (t : Π j, α j → set (β j)) :
  pi univ (λ j, t j (update f i a j)) = {x | x i ∈ t i a} ∩ pi {i}ᶜ (λ j, t j (f j)) :=
by rw [compl_eq_univ_diff, ← pi_update_of_mem (mem_univ _)]

lemma univ_pi_update_univ [decidable_eq ι] (i : ι) (s : set (α i)) :
  pi univ (update (λ j : ι, (univ : set (α j))) i s) = eval i ⁻¹' s :=
by rw [univ_pi_update i (λ j, (univ : set (α j))) s (λ j t, t), pi_univ, inter_univ, preimage]

lemma eval_image_pi (hs : i ∈ s) (ht : (s.pi t).nonempty) : eval i '' s.pi t = t i :=
begin
  classical,
  ext x,
  obtain ⟨f, hf⟩ := ht,
  refine ⟨_, λ hg, ⟨update f i x, λ j hj, _, by simp⟩⟩,
  { rintro ⟨g, hg, rfl⟩,
    exact hg i hs },
  { obtain rfl | hji := eq_or_ne j i,
    { simp [hg] },
    { rw [mem_pi] at hf, simp [hji, hf _ hj] } }
end

@[simp] lemma eval_image_univ_pi (ht : (pi univ t).nonempty) :
  (λ f : Π i, α i, f i) '' pi univ t = t i :=
eval_image_pi (mem_univ i) ht

lemma eval_preimage [decidable_eq ι] {s : set (α i)} :
  eval i ⁻¹' s = pi univ (update (λ i, univ) i s) :=
by { ext x, simp [@forall_update_iff _ (λ i, set (α i)) _ _ _ _ (λ i' y, x i' ∈ y)] }

lemma eval_preimage' [decidable_eq ι] {s : set (α i)} :
  eval i ⁻¹' s = pi {i} (update (λ i, univ) i s) :=
by { ext, simp }

lemma update_preimage_pi [decidable_eq ι] {f : Π i, α i} (hi : i ∈ s)
  (hf : ∀ j ∈ s, j ≠ i → f j ∈ t j) :
  (update f i) ⁻¹' s.pi t = t i :=
begin
  ext x,
  refine ⟨λ h, _, λ hx j hj, _⟩,
  { convert h i hi,
    simp },
  { obtain rfl | h := eq_or_ne j i,
    { simpa },
    { rw update_noteq h,
      exact hf j hj h } }
end

lemma update_preimage_univ_pi [decidable_eq ι] {f : Π i, α i} (hf : ∀ j ≠ i, f j ∈ t j) :
  (update f i) ⁻¹' pi univ t = t i :=
update_preimage_pi (mem_univ i) (λ j _, hf j)

lemma subset_pi_eval_image (s : set ι) (u : set (Π i, α i)) : u ⊆ pi s (λ i, eval i '' u) :=
λ f hf i hi, ⟨f, hf, rfl⟩

lemma univ_pi_ite (s : set ι) [decidable_pred (∈ s)] (t : Π i, set (α i)) :
  pi univ (λ i, if i ∈ s then t i else univ) = s.pi t :=
by { ext, simp_rw [mem_univ_pi], refine forall_congr (λ i, _), split_ifs; simp [h] }

end pi
end set


/-
Copyright (c) 2018  Patrick Massot. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Patrick Massot, Chris Hughes, Michael Howes
-/
import data.fintype.basic
import algebra.group.hom
import algebra.group.semiconj
import data.equiv.mul_add_aut
import algebra.group_with_zero.basic

/-!
# Conjugacy of group elements

See also `mul_aut.conj` and `quandle.conj`.
-/

universes u v
variables {α : Type u} {β : Type v}

section monoid

variables [monoid α] [monoid β]

/-- We say that `a` is conjugate to `b` if for some unit `c` we have `c * a * c⁻¹ = b`. -/
def is_conj (a b : α) := ∃ c : units α, semiconj_by ↑c a b

@[refl] lemma is_conj_refl (a : α) : is_conj a a :=
⟨1, semiconj_by.one_left a⟩

@[symm] lemma is_conj_symm {a b : α} : is_conj a b → is_conj b a
| ⟨c, hc⟩ := ⟨c⁻¹, hc.units_inv_symm_left⟩

@[trans] lemma is_conj_trans {a b c : α} : is_conj a b → is_conj b c → is_conj a c
| ⟨c₁, hc₁⟩ ⟨c₂, hc₂⟩ := ⟨c₂ * c₁, hc₂.mul_left hc₁⟩

@[simp] lemma is_conj_iff_eq {α : Type*} [comm_monoid α] {a b : α} : is_conj a b ↔ a = b :=
⟨λ ⟨c, hc⟩, begin
  rw [semiconj_by, mul_comm, ← units.mul_inv_eq_iff_eq_mul, mul_assoc, c.mul_inv, mul_one] at hc,
  exact hc,
end, λ h, by rw h⟩

protected lemma monoid_hom.map_is_conj (f : α →* β) {a b : α} : is_conj a b → is_conj (f a) (f b)
| ⟨c, hc⟩ := ⟨units.map f c, by rw [units.coe_map, semiconj_by, ← f.map_mul, hc.eq, f.map_mul]⟩

end monoid

section group

variables [group α]

@[simp] lemma is_conj_iff {a b : α} :
  is_conj a b ↔ ∃ c : α, c * a * c⁻¹ = b :=
⟨λ ⟨c, hc⟩, ⟨c, mul_inv_eq_iff_eq_mul.2 hc⟩, λ ⟨c, hc⟩,
  ⟨⟨c, c⁻¹, mul_inv_self c, inv_mul_self c⟩, mul_inv_eq_iff_eq_mul.1 hc⟩⟩

@[simp] lemma is_conj_one_right {a : α} : is_conj 1 a  ↔ a = 1 :=
⟨λ ⟨c, hc⟩, mul_right_cancel (hc.symm.trans ((mul_one _).trans (one_mul _).symm)), λ h, by rw [h]⟩

@[simp] lemma is_conj_one_left {a : α} : is_conj a 1 ↔ a = 1 :=
calc is_conj a 1 ↔ is_conj 1 a : ⟨is_conj_symm, is_conj_symm⟩
... ↔ a = 1 : is_conj_one_right

@[simp] lemma conj_inv {a b : α} : (b * a * b⁻¹)⁻¹ = b * a⁻¹ * b⁻¹ :=
((mul_aut.conj b).map_inv a).symm

@[simp] lemma conj_mul {a b c : α} : (b * a * b⁻¹) * (b * c * b⁻¹) = b * (a * c) * b⁻¹ :=
((mul_aut.conj b).map_mul a c).symm

@[simp] lemma conj_pow {i : ℕ} {a b : α} : (a * b * a⁻¹) ^ i = a * (b ^ i) * a⁻¹ :=
begin
  induction i with i hi,
  { simp },
  { simp [pow_succ, hi] }
end

@[simp] lemma conj_gpow {i : ℤ} {a b : α} : (a * b * a⁻¹) ^ i = a * (b ^ i) * a⁻¹ :=
begin
  induction i,
  { simp },
  { simp [gpow_neg_succ_of_nat, conj_pow] }
end

lemma conj_injective {x : α} : function.injective (λ (g : α), x * g * x⁻¹) :=
(mul_aut.conj x).injective

end group

@[simp] lemma is_conj_iff' [group_with_zero α] {a b : α} :
  is_conj a b ↔ ∃ c : α, c ≠ 0 ∧ c * a * c⁻¹ = b :=
⟨λ ⟨c, hc⟩, ⟨c, begin
    rw [← units.coe_inv', units.mul_inv_eq_iff_eq_mul],
    exact ⟨c.ne_zero, hc⟩,
  end⟩, λ ⟨c, c0, hc⟩,
  ⟨units.mk0 c c0, begin
    rw [semiconj_by, ← units.mul_inv_eq_iff_eq_mul, units.coe_inv', units.coe_mk0],
    exact hc
  end⟩⟩

namespace is_conj
/- This small quotient API is largely copied from the API of `associates`;
where possible, try to keep them in sync -/

/-- The setoid of the relation `is_conj` iff there is a unit `u` such that `u * x = y * u` -/
protected def setoid (α : Type*) [monoid α] : setoid α :=
{ r := is_conj, iseqv := ⟨is_conj_refl, λa b, is_conj_symm, λa b c, is_conj_trans⟩ }

end is_conj

local attribute [instance, priority 100] is_conj.setoid

/-- The quotient type of conjugacy classes of a group. -/
def conj_classes (α : Type*) [monoid α] : Type* :=
quotient (is_conj.setoid α)

namespace conj_classes

section monoid
variables [monoid α] [monoid β]

/-- The canonical quotient map from a monoid `α` into the `conj_classes` of `α` -/
protected def mk {α : Type*} [monoid α] (a : α) : conj_classes α :=
⟦a⟧

instance : inhabited (conj_classes α) := ⟨⟦1⟧⟩

theorem mk_eq_mk_iff_is_conj {a b : α} :
  conj_classes.mk a = conj_classes.mk b ↔ is_conj a b :=
iff.intro quotient.exact quot.sound

theorem quotient_mk_eq_mk (a : α) : ⟦ a ⟧ = conj_classes.mk a := rfl

theorem quot_mk_eq_mk (a : α) : quot.mk setoid.r a = conj_classes.mk a := rfl

theorem forall_is_conj {p : conj_classes α → Prop} :
  (∀a, p a) ↔ (∀a, p (conj_classes.mk a)) :=
iff.intro
  (assume h a, h _)
  (assume h a, quotient.induction_on a h)

theorem mk_surjective : function.surjective (@conj_classes.mk α _) :=
forall_is_conj.2 (λ a, ⟨a, rfl⟩)

instance : has_one (conj_classes α) := ⟨⟦ 1 ⟧⟩

theorem one_eq_mk_one : (1 : conj_classes α) = conj_classes.mk 1 := rfl

lemma exists_rep (a : conj_classes α) : ∃ a0 : α, conj_classes.mk a0 = a :=
quot.exists_rep a

/-- A `monoid_hom` maps conjugacy classes of one group to conjugacy classes of another. -/
def map (f : α →* β) : conj_classes α → conj_classes β :=
quotient.lift (conj_classes.mk ∘ f) (λ a b ab, mk_eq_mk_iff_is_conj.2 (f.map_is_conj ab))

instance [fintype α] [decidable_rel (is_conj : α → α → Prop)] :
  fintype (conj_classes α) :=
quotient.fintype (is_conj.setoid α)

end monoid

section comm_monoid
variable [comm_monoid α]

lemma mk_injective : function.injective (@conj_classes.mk α _) :=
λ _ _, (mk_eq_mk_iff_is_conj.trans is_conj_iff_eq).1

lemma mk_bijective : function.bijective (@conj_classes.mk α _) :=
⟨mk_injective, mk_surjective⟩

/-- The bijection between a `comm_group` and its `conj_classes`. -/
def mk_equiv : α ≃ conj_classes α :=
⟨conj_classes.mk, quotient.lift id (λ (a : α) b, is_conj_iff_eq.1), quotient.lift_mk _ _,
  begin
    rw [function.right_inverse, function.left_inverse, forall_is_conj],
    intro x,
    rw [← quotient_mk_eq_mk, ← quotient_mk_eq_mk, quotient.lift_mk, id.def],
  end⟩

end comm_monoid
end conj_classes

section monoid

variables [monoid α]

/-- Given an element `a`, `conjugates a` is the set of conjugates. -/
def conjugates_of (a : α) : set α := {b | is_conj a b}

lemma mem_conjugates_of_self {a : α} : a ∈ conjugates_of a := is_conj_refl _

lemma is_conj.conjugates_of_eq {a b : α} (ab : is_conj a b) :
  conjugates_of a = conjugates_of b :=
set.ext (λ g, ⟨λ ag, is_conj_trans (is_conj_symm ab) ag, λ bg, is_conj_trans ab bg⟩)

lemma is_conj_iff_conjugates_of_eq {a b : α} :
  is_conj a b ↔ conjugates_of a = conjugates_of b :=
⟨is_conj.conjugates_of_eq, λ h, begin
  have ha := mem_conjugates_of_self,
  rwa ← h at ha,
end⟩

end monoid

namespace conj_classes

variables [monoid α]

local attribute [instance] is_conj.setoid

/-- Given a conjugacy class `a`, `carrier a` is the set it represents. -/
def carrier : conj_classes α → set α :=
quotient.lift conjugates_of (λ (a : α) b ab, is_conj.conjugates_of_eq ab)

lemma mem_carrier_mk {a : α} : a ∈ carrier (conj_classes.mk a) := is_conj_refl _

lemma mem_carrier_iff_mk_eq {a : α} {b : conj_classes α} :
  a ∈ carrier b ↔ conj_classes.mk a = b :=
begin
  revert b,
  rw forall_is_conj,
  intro b,
  rw [carrier, eq_comm, mk_eq_mk_iff_is_conj, ← quotient_mk_eq_mk, quotient.lift_mk],
  refl,
end

lemma carrier_eq_preimage_mk {a : conj_classes α} :
  a.carrier = conj_classes.mk ⁻¹' {a} :=
set.ext (λ x, mem_carrier_iff_mk_eq)

end conj_classes


import linear_algebra
-- 1.
-- (ii) Let V be the vector space of all 2×2 matrices over R. Which of the following functions T : V −→ V are linear transformations?
-- (a) T(A)=A2 ∀A∈V􏰃
-- (b) T(A)= −1 1 A ∀ A∈V
-- Find a linear transformation T : R2 −→ R3 which sends (1,0) to (1,1,0) and (1, 1) to (1, 0, −1).
-- (i) Which of the following functions T : R3 −→ R2 are linear transformations? (a) T(x1,x2,x3)=(x1 +x2 −x3,2x1 +x2)
-- (b) T (x1, x2, x3) = (0,
-- (c) T(x1,x2,x3)=(x1x2,x3)
-- (iii) (a)
-- (b) Find two different linear transformations R3 −→ R2 which send (1, 1, 0) to (1, 1)
-- *2.
-- and (0, 1, 1) to (0, 1).
-- (i) Give an example of a linear transformation T : R2 −→ R3 such that T(v) = (1,0,0) for exactly one vector v ∈ R2.
-- (ii) Give an example of a linear transformation T : R2 −→ R3 such that T(v) = (1,0,0) for no vector v ∈ R2.
-- (iii) Give an example of a linear transformation T : R2 −→ R3 such that T(v) = (1,0,0) for infinitely many vectors v ∈ R2.
-- (iv) Show that there is no linear transformation T : R2 −→ R3 such that T (v) = (1, 0, 0) for exactly two vectors v ∈ R2.
-- 3.
-- (ii) Let V be the vector space of polynomials of degree at most 2 over R. Define T : V −→ V by
-- T(ax2 +bx+c)=(a+b+c)x2 +(c−a)x+(a+3b+5c). Find bases of Ker(T) and Im(T).
-- (i) Define T : R3 −→ R3 by T(x1,x2,x3) = (x1 − x2,x2 − x3,x3 − x1). Find bases of Ker(T) and Im(T). For which values of k is the vector (1,3,k) in Ker(T) or Im(T)?
-- (iii) Let V be as in part (ii), and define S : V −→ V by
-- S(p(x)) = p(1 + x) − p(x) for p(x) ∈ V.
-- (So for example, S(x2) = (x+1)2−x2 = 2x+1.) Show that S is a linear transformation, and find bases of Ker(S) and Im(S).
-- 4.
-- (b) Prove that T is surjective if and only if Ker(T ) = {0}.
-- (ii) Find an example of a linear transformation T : R2 −→ R2 such that Ker(T ) = Im(T ).
-- (iii) Prove that there does not exist a linear transformation T : R3 −→ R3 such that Ker(T ) = Im(T ).


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bhavik Mehta, Scott Morrison
-/
import category_theory.subobject.lattice

/-!
# Specific subobjects

We define `equalizer_subobject`, `kernel_subobject` and `image_subobject`, which are the subobjects
represented by the equalizer, kernel and image of (a pair of) morphism(s) and provide conditions
for `P.factors f`, where `P` is one of these special subobjects.

TODO: Add conditions for when `P` is a pullback subobject.
TODO: an iff characterisation of `(image_subobject f).factors h`

-/

universes v u

noncomputable theory

open category_theory category_theory.category category_theory.limits category_theory.subobject
  opposite

variables {C : Type u} [category.{v} C] {X Y Z : C}

namespace category_theory

namespace limits

section equalizer
variables (f g : X ⟶ Y) [has_equalizer f g]

/-- The equalizer of morphisms `f g : X ⟶ Y` as a `subobject X`. -/
abbreviation equalizer_subobject : subobject X :=
subobject.mk (equalizer.ι f g)

/-- The underlying object of `equalizer_subobject f g` is (up to isomorphism!)
the same as the chosen object `equalizer f g`. -/
def equalizer_subobject_iso : (equalizer_subobject f g : C) ≅ equalizer f g :=
subobject.underlying_iso (equalizer.ι f g)

@[simp, reassoc]
lemma equalizer_subobject_arrow :
  (equalizer_subobject_iso f g).hom ≫ equalizer.ι f g = (equalizer_subobject f g).arrow :=
by simp [equalizer_subobject_iso]

@[simp, reassoc]
lemma equalizer_subobject_arrow' :
  (equalizer_subobject_iso f g).inv ≫ (equalizer_subobject f g).arrow = equalizer.ι f g :=
by simp [equalizer_subobject_iso]

@[reassoc]
lemma equalizer_subobject_arrow_comp :
  (equalizer_subobject f g).arrow ≫ f = (equalizer_subobject f g).arrow ≫ g :=
by rw [←equalizer_subobject_arrow, category.assoc, category.assoc, equalizer.condition]

lemma equalizer_subobject_factors {W : C} (h : W ⟶ X) (w : h ≫ f = h ≫ g) :
  (equalizer_subobject f g).factors h :=
⟨equalizer.lift h w, by simp⟩

lemma equalizer_subobject_factors_iff {W : C} (h : W ⟶ X) :
  (equalizer_subobject f g).factors h ↔ h ≫ f = h ≫ g :=
⟨λ w, by rw [←subobject.factor_thru_arrow _ _ w, category.assoc,
  equalizer_subobject_arrow_comp, category.assoc],
equalizer_subobject_factors f g h⟩

end equalizer

section kernel
variables [has_zero_morphisms C] (f : X ⟶ Y) [has_kernel f]

/-- The kernel of a morphism `f : X ⟶ Y` as a `subobject X`. -/
abbreviation kernel_subobject : subobject X :=
subobject.mk (kernel.ι f)

/-- The underlying object of `kernel_subobject f` is (up to isomorphism!)
the same as the chosen object `kernel f`. -/
def kernel_subobject_iso :
  (kernel_subobject f : C) ≅ kernel f :=
subobject.underlying_iso (kernel.ι f)

@[simp, reassoc, elementwise]
lemma kernel_subobject_arrow :
  (kernel_subobject_iso f).hom ≫ kernel.ι f = (kernel_subobject f).arrow :=
by simp [kernel_subobject_iso]

@[simp, reassoc, elementwise]
lemma kernel_subobject_arrow' :
  (kernel_subobject_iso f).inv ≫ (kernel_subobject f).arrow = kernel.ι f :=
by simp [kernel_subobject_iso]

@[simp, reassoc, elementwise]
lemma kernel_subobject_arrow_comp :
  (kernel_subobject f).arrow ≫ f = 0 :=
by { rw [←kernel_subobject_arrow], simp only [category.assoc, kernel.condition, comp_zero], }

lemma kernel_subobject_factors {W : C} (h : W ⟶ X) (w : h ≫ f = 0) :
  (kernel_subobject f).factors h :=
⟨kernel.lift _ h w, by simp⟩

lemma kernel_subobject_factors_iff {W : C} (h : W ⟶ X) :
  (kernel_subobject f).factors h ↔ h ≫ f = 0 :=
⟨λ w, by rw [←subobject.factor_thru_arrow _ _ w, category.assoc,
  kernel_subobject_arrow_comp, comp_zero],
kernel_subobject_factors f h⟩

/-- A factorisation of `h : W ⟶ X` through `kernel_subobject f`, assuming `h ≫ f = 0`. -/
def factor_thru_kernel_subobject {W : C} (h : W ⟶ X) (w : h ≫ f = 0) :
  W ⟶ kernel_subobject f :=
(kernel_subobject f).factor_thru h (kernel_subobject_factors f h w)

@[simp] lemma factor_thru_kernel_subobject_comp_arrow {W : C} (h : W ⟶ X) (w : h ≫ f = 0) :
  factor_thru_kernel_subobject f h w ≫ (kernel_subobject f).arrow = h :=
by { dsimp [factor_thru_kernel_subobject], simp, }

@[simp] lemma factor_thru_kernel_subobject_comp_kernel_subobject_iso {W : C} (h : W ⟶ X)
  (w : h ≫ f = 0) :
  factor_thru_kernel_subobject f h w ≫ (kernel_subobject_iso f).hom = kernel.lift f h w :=
(cancel_mono (kernel.ι f)).1 $ by simp

section
variables {f} {X' Y' : C} {f' : X' ⟶ Y'} [has_kernel f']

/-- A commuting square induces a morphism between the kernel subobjects. -/
def kernel_subobject_map (sq : arrow.mk f ⟶ arrow.mk f') :
  (kernel_subobject f : C) ⟶ (kernel_subobject f' : C) :=
subobject.factor_thru _
  ((kernel_subobject f).arrow ≫ sq.left)
  (kernel_subobject_factors _ _ (by simp [sq.w]))

@[simp, reassoc, elementwise]
lemma kernel_subobject_map_arrow (sq : arrow.mk f ⟶ arrow.mk f') :
  kernel_subobject_map sq ≫ (kernel_subobject f').arrow =
    (kernel_subobject f).arrow ≫ sq.left :=
by simp [kernel_subobject_map]

@[simp] lemma kernel_subobject_map_id : kernel_subobject_map (𝟙 (arrow.mk f)) = 𝟙 _ :=
by { ext, simp, dsimp, simp, } -- See library note [dsimp, simp].

@[simp] lemma kernel_subobject_map_comp {X'' Y'' : C} {f'' : X'' ⟶ Y''} [has_kernel f'']
  (sq : arrow.mk f ⟶ arrow.mk f') (sq' : arrow.mk f' ⟶ arrow.mk f'') :
  kernel_subobject_map (sq ≫ sq') = kernel_subobject_map sq ≫ kernel_subobject_map sq' :=
by { ext, simp, }

@[reassoc] lemma kernel_map_comp_kernel_subobject_iso_inv (sq : arrow.mk f ⟶ arrow.mk f') :
  kernel.map f f' sq.1 sq.2 sq.3.symm ≫ (kernel_subobject_iso _).inv =
    (kernel_subobject_iso _).inv ≫ kernel_subobject_map sq :=
by ext; simp

@[reassoc] lemma kernel_subobject_iso_comp_kernel_map
  (sq : arrow.mk f ⟶ arrow.mk f') :
  (kernel_subobject_iso _).hom ≫ kernel.map f f' sq.1 sq.2 sq.3.symm =
    kernel_subobject_map sq ≫ (kernel_subobject_iso _).hom :=
by simp [←iso.comp_inv_eq, kernel_map_comp_kernel_subobject_iso_inv]

end

@[simp]
lemma kernel_subobject_zero {A B : C} : kernel_subobject (0 : A ⟶ B) = ⊤ :=
(is_iso_iff_mk_eq_top _).mp (by apply_instance)

instance is_iso_kernel_subobject_zero_arrow : is_iso (kernel_subobject (0 : X ⟶ Y)).arrow :=
(is_iso_arrow_iff_eq_top _).mpr kernel_subobject_zero

lemma le_kernel_subobject (A : subobject X) (h : A.arrow ≫ f = 0) : A ≤ kernel_subobject f :=
subobject.le_mk_of_comm (kernel.lift f A.arrow h) (by simp)

/--
The isomorphism between the kernel of `f ≫ g` and the kernel of `g`,
when `f` is an isomorphism.
-/
def kernel_subobject_iso_comp
  {X' : C} (f : X' ⟶ X) [is_iso f] (g : X ⟶ Y) [has_kernel g] :
  (kernel_subobject (f ≫ g) : C) ≅ (kernel_subobject g : C) :=
(kernel_subobject_iso _) ≪≫ (kernel_is_iso_comp f g) ≪≫ (kernel_subobject_iso _).symm

@[simp]
lemma kernel_subobject_iso_comp_hom_arrow
  {X' : C} (f : X' ⟶ X) [is_iso f] (g : X ⟶ Y) [has_kernel g] :
  (kernel_subobject_iso_comp f g).hom ≫ (kernel_subobject g).arrow =
    (kernel_subobject (f ≫ g)).arrow ≫ f :=
by { simp [kernel_subobject_iso_comp], }

@[simp]
lemma kernel_subobject_iso_comp_inv_arrow
  {X' : C} (f : X' ⟶ X) [is_iso f] (g : X ⟶ Y) [has_kernel g] :
  (kernel_subobject_iso_comp f g).inv ≫ (kernel_subobject (f ≫ g)).arrow =
    (kernel_subobject g).arrow ≫ inv f :=
by { simp [kernel_subobject_iso_comp], }

/-- The kernel of `f` is always a smaller subobject than the kernel of `f ≫ h`. -/
lemma kernel_subobject_comp_le
  (f : X ⟶ Y) [has_kernel f] {Z : C} (h : Y ⟶ Z) [has_kernel (f ≫ h)]:
  kernel_subobject f ≤ kernel_subobject (f ≫ h) :=
le_kernel_subobject _ _ (by simp)

/-- Postcomposing by an monomorphism does not change the kernel subobject. -/
@[simp]
lemma kernel_subobject_comp_mono
  (f : X ⟶ Y) [has_kernel f] {Z : C} (h : Y ⟶ Z) [mono h] :
  kernel_subobject (f ≫ h) = kernel_subobject f :=
le_antisymm
  (le_kernel_subobject _ _ ((cancel_mono h).mp (by simp)))
  (kernel_subobject_comp_le f h)

instance kernel_subobject_comp_mono_is_iso
  (f : X ⟶ Y) [has_kernel f] {Z : C} (h : Y ⟶ Z) [mono h] :
  is_iso (subobject.of_le _ _ (kernel_subobject_comp_le f h)) :=
begin
  rw of_le_mk_le_mk_of_comm (kernel_comp_mono f h).inv,
  { apply_instance, },
  { simp, },
end

/-- Taking cokernels is an order-reversing map from the subobjects of `X` to the quotient objects
    of `X`. -/
@[simps]
def cokernel_order_hom [has_cokernels C] (X : C) : subobject X →o (subobject (op X))ᵒᵈ :=
{ to_fun := subobject.lift (λ A f hf, subobject.mk (cokernel.π f).op)
  begin
    rintros A B f g hf hg i rfl,
    refine subobject.mk_eq_mk_of_comm _ _ (iso.op _) (quiver.hom.unop_inj _),
    { exact (is_colimit.cocone_point_unique_up_to_iso (colimit.is_colimit _)
        (is_cokernel_epi_comp (colimit.is_colimit _) i.hom rfl)).symm },
    { simp only [iso.comp_inv_eq, iso.op_hom, iso.symm_hom, unop_comp, quiver.hom.unop_op,
        colimit.comp_cocone_point_unique_up_to_iso_hom, cofork.of_π_ι_app, coequalizer.cofork_π] }
  end,
  monotone' := subobject.ind₂ _ $
  begin
    introsI A B f g hf hg h,
    dsimp only [subobject.lift_mk],
    refine subobject.mk_le_mk_of_comm (cokernel.desc f (cokernel.π g) _).op _,
    { rw [← subobject.of_mk_le_mk_comp h, category.assoc, cokernel.condition, comp_zero] },
    { exact quiver.hom.unop_inj (cokernel.π_desc _ _ _) }
  end }

/-- Taking kernels is an order-reversing map from the quotient objects of `X` to the subobjects of
    `X`. -/
@[simps]
def kernel_order_hom [has_kernels C] (X : C) : (subobject (op X))ᵒᵈ →o subobject X :=
{ to_fun := subobject.lift (λ A f hf, subobject.mk (kernel.ι f.unop))
  begin
    rintros A B f g hf hg i rfl,
    refine subobject.mk_eq_mk_of_comm _ _ _ _,
    { exact is_limit.cone_point_unique_up_to_iso (limit.is_limit _)
        (is_kernel_comp_mono (limit.is_limit (parallel_pair g.unop 0)) i.unop.hom rfl) },
    { dsimp,
      simp only [←iso.eq_inv_comp, limit.cone_point_unique_up_to_iso_inv_comp, fork.of_ι_π_app] }
  end,
  monotone' := subobject.ind₂ _ $
  begin
    introsI A B f g hf hg h,
    dsimp only [subobject.lift_mk],
    refine subobject.mk_le_mk_of_comm (kernel.lift g.unop (kernel.ι f.unop) _) _,
    { rw [← subobject.of_mk_le_mk_comp h, unop_comp, kernel.condition_assoc, zero_comp] },
    { exact quiver.hom.op_inj (by simp) }
  end }

end kernel

section image
variables (f : X ⟶ Y) [has_image f]

/-- The image of a morphism `f g : X ⟶ Y` as a `subobject Y`. -/
abbreviation image_subobject : subobject Y :=
subobject.mk (image.ι f)

/-- The underlying object of `image_subobject f` is (up to isomorphism!)
the same as the chosen object `image f`. -/
def image_subobject_iso :
  (image_subobject f : C) ≅ image f :=
subobject.underlying_iso (image.ι f)

@[simp, reassoc]
lemma image_subobject_arrow :
  (image_subobject_iso f).hom ≫ image.ι f = (image_subobject f).arrow :=
by simp [image_subobject_iso]

@[simp, reassoc]
lemma image_subobject_arrow' :
  (image_subobject_iso f).inv ≫ (image_subobject f).arrow = image.ι f :=
by simp [image_subobject_iso]

/-- A factorisation of `f : X ⟶ Y` through `image_subobject f`. -/
def factor_thru_image_subobject : X ⟶ image_subobject f :=
factor_thru_image f ≫ (image_subobject_iso f).inv

instance [has_equalizers C] : epi (factor_thru_image_subobject f) :=
by { dsimp [factor_thru_image_subobject], apply epi_comp, }

@[simp, reassoc, elementwise]
lemma image_subobject_arrow_comp :
  factor_thru_image_subobject f ≫ (image_subobject f).arrow = f :=
by simp [factor_thru_image_subobject, image_subobject_arrow]

lemma image_subobject_arrow_comp_eq_zero
  [has_zero_morphisms C] {X Y Z : C} {f : X ⟶ Y} {g : Y ⟶ Z} [has_image f]
  [epi (factor_thru_image_subobject f)] (h : f ≫ g = 0) : (image_subobject f).arrow ≫ g = 0 :=
zero_of_epi_comp (factor_thru_image_subobject f) $ by simp [h]

@[simp]
lemma factor_thru_image_subobject_comp_self {W : C} (k : W ⟶ X) (h) :
  (image_subobject f).factor_thru (k ≫ f) h = k ≫ factor_thru_image_subobject f :=
by { ext, simp, }

@[simp]
lemma factor_thru_image_subobject_comp_self_assoc {W W' : C} (k : W ⟶ W') (k' : W' ⟶ X) (h) :
  (image_subobject f).factor_thru (k ≫ k' ≫ f) h = k ≫ k' ≫ factor_thru_image_subobject f :=
by { ext, simp, }

/-- The image of `h ≫ f` is always a smaller subobject than the image of `f`. -/
lemma image_subobject_comp_le
  {X' : C} (h : X' ⟶ X) (f : X ⟶ Y) [has_image f] [has_image (h ≫ f)] :
  image_subobject (h ≫ f) ≤ image_subobject f :=
subobject.mk_le_mk_of_comm (image.pre_comp h f) (by simp)

section
open_locale zero_object
variables [has_zero_morphisms C] [has_zero_object C]

@[simp]
lemma image_subobject_zero_arrow :
  (image_subobject (0 : X ⟶ Y)).arrow = 0 :=
by { rw ←image_subobject_arrow, simp, }

@[simp]
lemma image_subobject_zero {A B : C} :
  image_subobject (0 : A ⟶ B) = ⊥ :=
subobject.eq_of_comm
  (image_subobject_iso _ ≪≫ image_zero ≪≫ subobject.bot_coe_iso_zero.symm) (by simp)

end

section
variables [has_equalizers C]
local attribute [instance] epi_comp

/--
The morphism `image_subobject (h ≫ f) ⟶ image_subobject f`
is an epimorphism when `h` is an epimorphism.
In general this does not imply that `image_subobject (h ≫ f) = image_subobject f`,
although it will when the ambient category is abelian.
 -/
instance image_subobject_comp_le_epi_of_epi
  {X' : C} (h : X' ⟶ X) [epi h] (f : X ⟶ Y) [has_image f] [has_image (h ≫ f)] :
  epi (subobject.of_le _ _ (image_subobject_comp_le h f)) :=
begin
  rw of_le_mk_le_mk_of_comm (image.pre_comp h f),
  { apply_instance, },
  { simp, },
end

end

section
variables [has_equalizers C]

/-- Postcomposing by an isomorphism gives an isomorphism between image subobjects. -/
def image_subobject_comp_iso
  (f : X ⟶ Y) [has_image f] {Y' : C} (h : Y ⟶ Y') [is_iso h] :
  (image_subobject (f ≫ h) : C) ≅ (image_subobject f : C) :=
(image_subobject_iso _) ≪≫ (image.comp_iso _ _).symm ≪≫ (image_subobject_iso _).symm

@[simp, reassoc]
lemma image_subobject_comp_iso_hom_arrow
  (f : X ⟶ Y) [has_image f] {Y' : C} (h : Y ⟶ Y') [is_iso h] :
  (image_subobject_comp_iso f h).hom ≫ (image_subobject f).arrow =
    (image_subobject (f ≫ h)).arrow ≫ inv h :=
by simp [image_subobject_comp_iso]

@[simp, reassoc]
lemma image_subobject_comp_iso_inv_arrow
  (f : X ⟶ Y) [has_image f] {Y' : C} (h : Y ⟶ Y') [is_iso h] :
  (image_subobject_comp_iso f h).inv ≫ (image_subobject (f ≫ h)).arrow =
    (image_subobject f).arrow ≫ h :=
by simp [image_subobject_comp_iso]

end

lemma image_subobject_mono (f : X ⟶ Y) [mono f] : image_subobject f = mk f :=
eq_of_comm (image_subobject_iso f ≪≫ image_mono_iso_source f ≪≫ (underlying_iso f).symm) (by simp)

/-- Precomposing by an isomorphism does not change the image subobject. -/
lemma image_subobject_iso_comp [has_equalizers C]
  {X' : C} (h : X' ⟶ X) [is_iso h] (f : X ⟶ Y) [has_image f] :
  image_subobject (h ≫ f) = image_subobject f :=
le_antisymm
  (image_subobject_comp_le h f)
  (subobject.mk_le_mk_of_comm (inv (image.pre_comp h f)) (by simp))

lemma image_subobject_le {A B : C} {X : subobject B} (f : A ⟶ B) [has_image f]
  (h : A ⟶ X) (w : h ≫ X.arrow = f) :
  image_subobject f ≤ X :=
subobject.le_of_comm
  ((image_subobject_iso f).hom ≫ image.lift { I := (X : C), e := h, m := X.arrow, })
  (by simp)

lemma image_subobject_le_mk {A B : C} {X : C} (g : X ⟶ B) [mono g] (f : A ⟶ B) [has_image f]
  (h : A ⟶ X) (w : h ≫ g = f) :
  image_subobject f ≤ subobject.mk g :=
image_subobject_le f (h ≫ (subobject.underlying_iso g).inv) (by simp [w])

/-- Given a commutative square between morphisms `f` and `g`,
we have a morphism in the category from `image_subobject f` to `image_subobject g`. -/
def image_subobject_map {W X Y Z : C} {f : W ⟶ X} [has_image f] {g : Y ⟶ Z} [has_image g]
  (sq : arrow.mk f ⟶ arrow.mk g) [has_image_map sq] :
  (image_subobject f : C) ⟶ (image_subobject g : C) :=
(image_subobject_iso f).hom ≫ image.map sq ≫ (image_subobject_iso g).inv

@[simp, reassoc]
lemma image_subobject_map_arrow {W X Y Z : C} {f : W ⟶ X} [has_image f] {g : Y ⟶ Z} [has_image g]
  (sq : arrow.mk f ⟶ arrow.mk g) [has_image_map sq] :
  image_subobject_map sq ≫ (image_subobject g).arrow = (image_subobject f).arrow ≫ sq.right :=
begin
  simp only [image_subobject_map, category.assoc, image_subobject_arrow'],
  erw [image.map_ι, ←category.assoc, image_subobject_arrow],
end

lemma image_map_comp_image_subobject_iso_inv
  {W X Y Z : C} {f : W ⟶ X} [has_image f] {g : Y ⟶ Z} [has_image g]
  (sq : arrow.mk f ⟶ arrow.mk g) [has_image_map sq] :
  image.map sq ≫ (image_subobject_iso _).inv =
  (image_subobject_iso _).inv ≫ image_subobject_map sq :=
by ext; simp

lemma image_subobject_iso_comp_image_map
  {W X Y Z : C} {f : W ⟶ X} [has_image f] {g : Y ⟶ Z} [has_image g]
  (sq : arrow.mk f ⟶ arrow.mk g) [has_image_map sq] :
  (image_subobject_iso _).hom ≫ image.map sq =
    image_subobject_map sq ≫ (image_subobject_iso _).hom :=
by rw [←iso.comp_inv_eq, category.assoc, ←(image_subobject_iso (arrow.mk f).hom).eq_inv_comp,
  ←image_map_comp_image_subobject_iso_inv]; refl

end image

end limits

end category_theory


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

! This file was ported from Lean 3 source module dynamics.ergodic.add_circle
! leanprover-community/mathlib commit f2ce6086713c78a7f880485f7917ea547a215982
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.MeasureTheory.Group.AddCircle
import Mathbin.Dynamics.Ergodic.Ergodic
import Mathbin.MeasureTheory.Covering.DensityTheorem
import Mathbin.Data.Set.Pointwise.Iterate

/-!
# Ergodic maps of the additive circle

This file contains proofs of ergodicity for maps of the additive circle.

## Main definitions:

 * `add_circle.ergodic_zsmul`: given `n : ℤ` such that `1 < |n|`, the self map `y ↦ n • y` on
   the additive circle is ergodic (wrt the Haar measure).
 * `add_circle.ergodic_nsmul`: given `n : ℕ` such that `1 < n`, the self map `y ↦ n • y` on
   the additive circle is ergodic (wrt the Haar measure).
 * `add_circle.ergodic_zsmul_add`: given `n : ℤ` such that `1 < |n|` and `x : add_circle T`, the
   self map `y ↦ n • y + x` on the additive circle is ergodic (wrt the Haar measure).
 * `add_circle.ergodic_nsmul_add`: given `n : ℕ` such that `1 < n` and `x : add_circle T`, the
   self map `y ↦ n • y + x` on the additive circle is ergodic (wrt the Haar measure).

-/

open Set Function MeasureTheory MeasureTheory.Measure Filter Metric

open MeasureTheory NNReal ENNReal Topology Pointwise

namespace AddCircle

variable {T : ℝ} [hT : Fact (0 < T)]

include hT

/-- If a null-measurable subset of the circle is almost invariant under rotation by a family of
rational angles with denominators tending to infinity, then it must be almost empty or almost full.
-/
theorem ae_empty_or_univ_of_forall_vadd_ae_eq_self {s : Set <| AddCircle T}
    (hs : NullMeasurableSet s volume) {ι : Type _} {l : Filter ι} [l.ne_bot] {u : ι → AddCircle T}
    (hu₁ : ∀ i, (u i +ᵥ s : Set _) =ᵐ[volume] s) (hu₂ : Tendsto (addOrderOf ∘ u) l atTop) :
    s =ᵐ[volume] (∅ : Set <| AddCircle T) ∨ s =ᵐ[volume] univ :=
  by
  /- Sketch of proof:
    Assume `T = 1` for simplicity and let `μ` be the Haar measure. We may assume `s` has positive
    measure since otherwise there is nothing to prove. In this case, by Lebesgue's density theorem,
    there exists a point `d` of positive density. Let `Iⱼ` be the sequence of closed balls about `d`
    of diameter `1 / nⱼ` where `nⱼ` is the additive order of `uⱼ`. Since `d` has positive density we
    must have `μ (s ∩ Iⱼ) / μ Iⱼ → 1` along `l`. However since `s` is invariant under the action of
    `uⱼ` and since `Iⱼ` is a fundamental domain for this action, we must have
    `μ (s ∩ Iⱼ) = nⱼ * μ s = (μ Iⱼ) * μ s`. We thus have `μ s → 1` and thus `μ s = 1`. -/
  set μ := (volume : Measure <| AddCircle T)
  set n : ι → ℕ := addOrderOf ∘ u
  have hT₀ : 0 < T := hT.out
  have hT₁ : ENNReal.ofReal T ≠ 0 := by simpa
  rw [ae_eq_empty, ae_eq_univ_iff_measure_eq hs, AddCircle.measure_univ]
  cases' eq_or_ne (μ s) 0 with h h
  · exact Or.inl h
  right
  obtain ⟨d, -, hd⟩ :
    ∃ d,
      d ∈ s ∧
        ∀ {ι'} {l : Filter ι'} (w : ι' → AddCircle T) (δ : ι' → ℝ),
          tendsto δ l (𝓝[>] 0) →
            (∀ᶠ j in l, d ∈ closed_ball (w j) (1 * δ j)) →
              tendsto (fun j => μ (s ∩ closed_ball (w j) (δ j)) / μ (closed_ball (w j) (δ j))) l
                (𝓝 1) :=
    exists_mem_of_measure_ne_zero_of_ae h (IsDoublingMeasure.ae_tendsto_measure_inter_div μ s 1)
  let I : ι → Set (AddCircle T) := fun j => closed_ball d (T / (2 * ↑(n j)))
  replace hd : tendsto (fun j => μ (s ∩ I j) / μ (I j)) l (𝓝 1)
  · let δ : ι → ℝ := fun j => T / (2 * ↑(n j))
    have hδ₀ : ∀ᶠ j in l, 0 < δ j :=
      (hu₂.eventually_gt_at_top 0).mono fun j hj => div_pos hT₀ <| by positivity
    have hδ₁ : tendsto δ l (𝓝[>] 0) :=
      by
      refine' tendsto_nhds_within_iff.mpr ⟨_, hδ₀⟩
      replace hu₂ : tendsto (fun j => T⁻¹ * 2 * n j) l at_top :=
        (tendsto_coe_nat_at_top_iff.mpr hu₂).const_mul_atTop (by positivity : 0 < T⁻¹ * 2)
      convert hu₂.inv_tendsto_at_top
      ext j
      simp only [δ, Pi.inv_apply, mul_inv_rev, inv_inv, div_eq_inv_mul, ← mul_assoc]
    have hw : ∀ᶠ j in l, d ∈ closed_ball d (1 * δ j) := hδ₀.mono fun j hj => by simp [hj.le]
    exact hd _ δ hδ₁ hw
  suffices ∀ᶠ j in l, μ (s ∩ I j) / μ (I j) = μ s / ENNReal.ofReal T
    by
    replace hd := hd.congr' this
    rwa [tendsto_const_nhds_iff, ENNReal.div_eq_one_iff hT₁ ENNReal.ofReal_ne_top] at hd
  refine' (hu₂.eventually_gt_at_top 0).mono fun j hj => _
  have huj : IsOfFinAddOrder (u j) := add_order_of_pos_iff.mp hj
  have huj' : 1 ≤ (↑(n j) : ℝ) := by
    norm_cast
    exact nat.succ_le_iff.mpr hj
  have hI₀ : μ (I j) ≠ 0 := (measure_closed_ball_pos _ d <| by positivity).Ne.symm
  have hI₁ : μ (I j) ≠ ⊤ := measure_ne_top _ _
  have hI₂ : μ (I j) * ↑(n j) = ENNReal.ofReal T :=
    by
    rw [volume_closed_ball, mul_div, mul_div_mul_left T _ two_ne_zero,
      min_eq_right (div_le_self hT₀.le huj'), mul_comm, ← nsmul_eq_mul, ← ENNReal.ofReal_nsmul,
      nsmul_eq_mul, mul_div_cancel']
    exact nat.cast_ne_zero.mpr hj.ne'
  rw [ENNReal.div_eq_div_iff hT₁ ENNReal.ofReal_ne_top hI₀ hI₁,
    volume_of_add_preimage_eq s _ (u j) d huj (hu₁ j) closed_ball_ae_eq_ball, nsmul_eq_mul, ←
    mul_assoc, hI₂]
#align add_circle.ae_empty_or_univ_of_forall_vadd_ae_eq_self AddCircle.ae_empty_or_univ_of_forall_vadd_ae_eq_self

theorem ergodicZsmul {n : ℤ} (hn : 1 < |n|) : Ergodic fun y : AddCircle T => n • y :=
  { measure_preserving_zsmul volume (abs_pos.mp <| lt_trans zero_lt_one hn) with
    ae_empty_or_univ := fun s hs hs' =>
      by
      let u : ℕ → AddCircle T := fun j => ↑((↑1 : ℝ) / ↑(n.nat_abs ^ j) * T)
      replace hn : 1 < n.nat_abs
      · rwa [Int.abs_eq_natAbs, Nat.one_lt_cast] at hn
      have hu₀ : ∀ j, addOrderOf (u j) = n.nat_abs ^ j := fun j =>
        add_order_of_div_of_gcd_eq_one (pow_pos (pos_of_gt hn) j) (gcd_one_left _)
      have hnu : ∀ j, n ^ j • u j = 0 := fun j => by
        rw [← addOrderOf_dvd_iff_zsmul_eq_zero, hu₀, Int.coe_nat_pow, Int.coe_natAbs, ← abs_pow,
          abs_dvd]
      have hu₁ : ∀ j, (u j +ᵥ s : Set _) =ᵐ[volume] s := fun j => by
        rw [vadd_eq_self_of_preimage_zsmul_eq_self hs' (hnu j)]
      have hu₂ : tendsto (fun j => addOrderOf <| u j) at_top at_top :=
        by
        simp_rw [hu₀]
        exact Nat.tendsto_pow_atTop_atTop_of_one_lt hn
      exact ae_empty_or_univ_of_forall_vadd_ae_eq_self hs.null_measurable_set hu₁ hu₂ }
#align add_circle.ergodic_zsmul AddCircle.ergodicZsmul

theorem ergodicNsmul {n : ℕ} (hn : 1 < n) : Ergodic fun y : AddCircle T => n • y :=
  ergodicZsmul (by simp [hn] : 1 < |(n : ℤ)|)
#align add_circle.ergodic_nsmul AddCircle.ergodicNsmul

theorem ergodicZsmulAdd (x : AddCircle T) {n : ℤ} (h : 1 < |n|) : Ergodic fun y => n • y + x :=
  by
  set f : AddCircle T → AddCircle T := fun y => n • y + x
  let e : AddCircle T ≃ᵐ AddCircle T := MeasurableEquiv.addLeft (DivisibleBy.div x <| n - 1)
  have he : measure_preserving e volume volume := measure_preserving_add_left volume _
  suffices e ∘ f ∘ e.symm = fun y => n • y
    by
    rw [← he.ergodic_conjugate_iff, this]
    exact ergodic_zsmul h
  replace h : n - 1 ≠ 0
  · rw [← abs_one] at h
    rw [sub_ne_zero]
    exact ne_of_apply_ne _ (ne_of_gt h)
  have hnx : n • DivisibleBy.div x (n - 1) = x + DivisibleBy.div x (n - 1) :=
    by
    conv_rhs =>
      congr
      rw [← DivisibleBy.div_cancel x h]
    rw [sub_smul, one_smul, sub_add_cancel]
  ext y
  simp only [f, hnx, MeasurableEquiv.coe_add_left, MeasurableEquiv.symm_add_left, comp_app,
    smul_add, zsmul_neg', neg_smul, neg_add_rev]
  abel
#align add_circle.ergodic_zsmul_add AddCircle.ergodicZsmulAdd

theorem ergodicNsmulAdd (x : AddCircle T) {n : ℕ} (h : 1 < n) : Ergodic fun y => n • y + x :=
  ergodicZsmulAdd x (by simp [h] : 1 < |(n : ℤ)|)
#align add_circle.ergodic_nsmul_add AddCircle.ergodicNsmulAdd

end AddCircle


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

/-

# Power World

## Level 6: `mul_pow`

You might find the tip at the end of level 9 of Multiplication World
useful in this one. You can go to the main menu and pop back into
Multiplication World and take a look -- you won't lose any of your
proofs. You'll only lose proofs if you reload the page.
-/

/- Lemma
For all naturals $a$, $b$, $n$, we have $(ab) ^ n = a ^ nb ^ n$.
-/
lemma mul_pow (a b n : mynat) : (a * b) ^ n = a ^ n * b ^ n :=
begin [nat_num_game]
  induction n with t Ht,
    rw [pow_zero, pow_zero, pow_zero, mul_one],
    refl,
  rw [pow_succ, pow_succ, pow_succ, Ht],
  simp,

end

end mynat -- hide


import number_theory.assorted_lemmas
import ring_theory.norm
import ring_theory.ideal.norm
import linear_algebra.free_module.finite.basic
-- import number_theory.class_number_bound
.
-- TODO reorganise context menu
noncomputable theory
open_locale classical

section ideal_norm
namespace ideal
variables {R : Type*} [comm_ring R]

-- TODO this proof is very ugly
-- TODO can this be generalized to any multiplicative map?
-- TODO can this be generalized to any submodule not just ideals?
lemma span_norm_singleton_eq_span_singleton_norm {r : R} :
  span (algebra.norm ℤ '' ((span ({r} : set R) : ideal R) : set R)) =
  span {algebra.norm ℤ r} :=
begin
  have : ∀ x ∈ (algebra.norm ℤ : R →* ℤ) '' ↑(span ({r} : set R)), algebra.norm ℤ r ∣ x,
  { intros x hx,
    rw set.mem_image at hx,
    rcases hx with ⟨hx_w, hx_h_left, rfl⟩,
    simp only [mem_span_singleton, set_like.mem_coe] at hx_h_left,
    exact map_dvd _ hx_h_left, },
  have : ∀ x ∈ span ((algebra.norm ℤ : R →* ℤ) '' ↑(span ({r} : set R))), algebra.norm ℤ r ∣ x,
  { intros x hx,
    apply submodule.span_induction hx this (dvd_zero _) (λ y z, dvd_add),
    intros a x ha,
    rw [algebra.id.smul_eq_mul],
    exact dvd_mul_of_dvd_right ha a, -- TODO should have a lemma dvd_smul_of_dvd_right?
  },
  apply le_antisymm,
  { erw submodule.le_span_singleton_iff,
    intros v hv,
    specialize this v hv,
    rw [dvd_iff_exists_eq_mul_left] at this,
    simp_rw eq_comm,
    simpa, },
  { erw submodule.span_singleton_le_iff_mem,
    exact submodule.subset_span (set.mem_image_of_mem _
      (submodule.subset_span (set.mem_singleton r))), },
end

-- TODO this might be useless
lemma coe_one : ((1 : ideal R) : set R) = set.univ :=
by simp [submodule.one_eq_span]
variables [is_domain R] [is_dedekind_domain R] [module.finite ℤ R] [module.free ℤ R]
-- this is a typeclassy way of saying that R is not a field

open ideal
/-
/-- The absolute norm of an ideal, as a multiplicative map from the set of ideals to the naturals -/
def abs_norm : ideal R →*₀ ℕ :=
{ to_fun := λ I, (ideal.norm ℤ I).nat_abs,
  map_zero' := by simp,
  map_one' := by simp,
  map_mul' := begin
    intros x y,
    obtain b := module.free.choose_basis ℤ R,
    rw [card_norm_eq_norm b, card_norm_eq_norm b, card_norm_eq_norm b, card_norm_mul b,
      nat.cast_mul, int.nat_abs_of_nat, int.nat_abs_mul, int.nat_abs_of_nat],
  end }

lemma abs_norm_def (I : ideal R) : abs_norm I = (ideal.norm ℤ I).nat_abs := rfl
--   int.nat_abs (submodule.is_principal.generator $ ideal.span (algebra.norm ℤ '' (I : set R))) :=
-- rfl
  -- abs_norm I = Sup ((λ r, (algebra.norm ℤ r).nat_abs) '' (I : set R)) := rfl
-/

end ideal
end ideal_norm


/-
Copyright © 2019, Oracle and/or its affiliates. All rights reserved.
-/

import .setup_properties
import .algorithm_properties

local attribute [instance] classical.prop_decidable

open set
open measure_theory
open well_founded

namespace stump

variables (μ: probability_measure ℍ) (target: ℍ) (n: ℕ)

lemma partition:
    ∀ θ,
    θ > 0 →
    {x : ℍ | ∀ (a: ℍ) (b: bool), (a,b) = label target x → ite b a 0 < θ}
    = - Icc θ target :=
begin
    introv h1,
    apply ext,
    intros,
    unfold Icc, unfold label, unfold rle,
    simp,
    split; intros,
    {
        simp at *, intros,
        by_contradiction, simp at a_2,
        have FOO:= a x tt _ _,
        {
            simp at FOO,
            have BAR: ¬ (θ ≤ x), simp, assumption,
            contradiction,
        },
        trivial,
        tidy,
    },
    {
        by_cases (b = tt),
        {
            rw h at *, simp, rw a_2,
            by_contradiction, simp at a_4,
            have INEQ1 := a a_4,
            have INEQ2: ¬ (x > target), {simp,tidy,},
            contradiction,
        },
        {
            simp at h, rw h at *, simp at *,
            tidy,
        },
    },
end

lemma miss_prob:
    ∀ ε, ∀ θ: nnreal, θ > 0 →
    μ (Icc θ target) ≥ ε →
    μ {x : ℍ | ∀ (a: ℍ) (b: bool), (a,b) = label target x → ite b a 0 < θ} ≤ 1 - ε:=
begin
    intros,
    rw partition,
    have STO := probability_measure.prob_comp μ (Icc θ target) _,
    have SWAP: μ (- Icc θ target) = 1 - μ (Icc θ target),
    {
        exact lc_nnreal (μ (-Icc θ target)) (μ (Icc θ target)) STO,
    },
    rw SWAP,
    {
        apply nnreal_sub_trans,
        assumption,
    },
    {
        apply is_measurable_of_is_closed,
        apply is_closed_Icc,
    },
    assumption,
end

lemma all_missed:
    ∀ ε: nnreal,
    ∀ θ: nnreal,
    μ (Ioc θ target) ≤ ε →
    {S: vec ℍ n | error μ target (choose n (label_sample target n S)) > ε} ⊆
    {S: vec ℍ n |  ∀ (i: dfin (nat.succ n)), ∀ p = label target (kth_projn S i), (if p.snd then p.fst else 0) < θ} :=
begin
    intros,
    conv {
        congr, congr, funext, rw (error_interval_1 μ target (choose n (label_sample target n S)) (choose_property_1 target n S)), skip, skip,
    },
    rw set_of_subset_set_of,
    intros,
    have QENI: not (μ (Ioc (choose n (label_sample target n a_1)) target) ≤ μ (Ioc θ target)),
    {
        simp,
        have BREAK_LEQ: μ (Ioc θ target) < ε ∨ μ (Ioc θ target) = ε,
        {
            exact lt_or_eq_of_le a,
        },
        cases BREAK_LEQ,
        transitivity ε; try {assumption,},
        rw BREAK_LEQ, assumption,
    },
    by_cases (p.snd = tt),
    {
        have PROP := choose_property_2 target n a_1 i p _ h,
        {
            rw h, simp,
            have INEQ1 := error_mono_interval μ target _ _ PROP _,
            by_contradiction, simp at a_3,
            have INEQ2 := error_mono_interval μ target _ _ a_3 _,
            have INEQ: μ (Ioc (choose n (label_sample target n a_1)) target) ≤ μ (Ioc θ target),
            {
                transitivity (μ (Ioc p.fst target)); try {assumption},
            }, clear INEQ1 INEQ2,
            contradiction,
            apply choose_property_3; try {assumption},
            {
                dunfold label_sample,
                rw ← kth_projn_map_comm,
                assumption,
            },
            apply choose_property_1,
        },
        {
            dunfold label_sample,
            rw ← kth_projn_map_comm,
            assumption,
        },
    },
    {
        simp at h, rw h, simp,
        have INEQ1': 0 ≤ choose n (label_sample target n a_1),
        {
            apply choose_property_4,
        },
        have INEQ1 := error_mono_interval μ target _ _ INEQ1' _, clear INEQ1',
        by_contradiction, simp at a_3,
        have GEN: θ ≤ 0,
        {
            exact le_of_eq a_3,
        },
        have INEQ2 := error_mono_interval μ target _ _ GEN _, clear GEN,
        have INEQ: μ (Ioc (choose n (label_sample target n a_1)) target) ≤ μ (Ioc θ target),
            {
                transitivity (μ (Ioc 0 target)); try {assumption},
            }, clear INEQ1 INEQ2,
        contradiction,
        tidy,
        apply choose_property_1,
    },
end

lemma always_succeed:
    ∀ ε: nnreal, ε > 0 → ∀ n: ℕ,
    μ (Ioc 0 target) ≤ ε →
    ∀ S: vec ℍ n, error μ target (choose n (label_sample target n S)) ≤ ε :=
begin
    intros,
    transitivity (μ (Ioc 0 target)); try {assumption},
    have HypIN := choose_property_1 target n S,
    have ERMONO := error_mono μ _ 0 (choose n (label_sample target n S)) _ HypIN,
    rw ← error_max,
    assumption,
    tidy,
end

end stump


/-
Lean for the Curious Mathematician
Tuesday, July 14, 2020
13:00 session
Happy Bastille Day!
-/

import data.real.basic

/-! ## Logic -/

/-!
### Agenda

- a quick overview of Lean's tactics for dealing with logical connectives
- continue with Patrick Massot's tutorial

After the overview, I will ask you to tell us how far you have gotten in the
tutorial (by file number), so we can group you in rooms accordingly. (Tutors,
please self identify as well!)

An apology:

In this presentation, I won't tell you anything you don't already know.

For example, I will say:

"To prove 'A and B', is suffices to prove A and then to prove B."

"If you know 'A and B', you can use A and you can use B."

The point is, to communicate these intentions to Lean, we have to give names
to these actions.

Analogies:

- Learning grammar.
- Learning Latex.

Other resources:

- Everything I go over here is in the tutorial.
- It is also in *Mathematics in Lean*.
- *Theorem Proving in Lean* has a more foundational, logician's perspective.
- See also the cheat sheet:

    https://leanprover-community.github.io//img/lean-tactics.pdf

You can find links to all of these (including the cheat sheet) on the mathlib
web pages, under "Learning resources."

This file is in the LFTCM repository.

Most of the examples here are from *Mathematics in Lean*.
-/

/-!
### Overview

The list:

→       \to, \r       if ... then         implication
∀       \all          for all             universal quantifier
∃       \ex           there exists        existential quantifier
¬       \not, \n      not                 negation
∧       \and          and                 conjunction
↔       \iff, \lr     if and only if      bi-implication
∨       \or           or                  disjunction
false                 contradiction       falsity
true                  this is trivial!    truth

Remember that a goal in Lean is of the form

  1 goal
  x y : ℕ,
  h₁ : prime x,
  h₂ : ¬even x,
  h₃ : y > x
  ⊢ y ≥ 4

The stuff before the `⊢` is called the *context*, or *local context*. The facts
there are called *hypotheses* or *local hypotheses*.

The stuff after the `⊢` is also called the *goal*, or the *target*.

A common theme:

- Some tactics tell us how to *prove* a goal involving the connective.
  (Logician's terminology: "introduce" the connective.)

- Some tactics tell us how to *use* a hypothesis involving the connective.
  (Logician's terminology: "eliminate" the connective.)

Summary:

→       if ... then       `intro`, `intros`     `apply`, `have h₃ := h₁ h₂`
∀       for all           `intro`, `intros`     `apply`, `specialize`,
                                                  `have h₂ := h₁ t`
∃       there exists      `use`                 `cases`
¬       not               `intro`, `intros`     `apply`, `contradiction`
∧       and               `split`               `cases`, `h.1` / `h.2`,
                                                  `h.left` / `h.right`
↔       if and only if    `split`               `cases`, `h.1` / `h.2`,
                                                  `h.mp` / `h.mpr`, `rw`
∨       or                `left` / `right`      `cases`
false   contradiction                           `contradiction`, `ex_falso`
true    this is trivial!  `trivial`

Also, for proof by contradiction:

  Use `open_locale classical` (but not right after the `import`s.)
  Use the `by_contradiction` tactic.

There are lots of other tactics and methods. But these are all you need to deal
with the logical connectives.

Another theme: sometimes the logical structure is hidden under a definition.
For example:

  `x ∣ y`   is existential
  `s ⊆ t`   is universal

Lean will unfold definitions as needed.
-/

/-!
### Implication and the universal quantifier
-/

section

variables   a b c d : ℝ
variable    h₁ : a ≤ b
variables   h₂ : c ≤ d

#check @add_le_add
#check @add_le_add _ _ _ _ _ a b
#check @add_le_add _ _ _ _ _ a b c d h₁
#check add_le_add h₁

include h₁ h₂

-- demonstrate variations on `apply` and `have`

example : a + c ≤ b + d :=
sorry

end

section

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

variables {f g : ℝ → ℝ} {a b : ℝ}

-- demonstrate variations on `apply`, `have`, and `specialize`
-- `dsimp` helps clarify the goal

theorem fn_ub_add (hfa : fn_ub f a) (hgb : fn_ub g b) :
  fn_ub (λ x, f x + g x) (a + b) :=
sorry

end

/-!
### The existential quantifier
-/

-- demonstrate `use` and `norm_num`

example : ∃ x : ℝ, 2 < x ∧ x < 3 :=
sorry

-- demonstrate `cases` and `use`, and use `fn_ub_add`

section

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

variables {f g : ℝ → ℝ}

example (ubf : fn_has_ub f) (ubg : fn_has_ub g) :
  fn_has_ub (λ x, f x + g x) :=
sorry

end

/-!
### Negation
-/

section

variable {f : ℝ → ℝ}

example (h : ∀ a, ∃ x, f x > a) : ¬ fn_has_ub f :=
sorry

end

/-!
### Conjunction
-/

section

variables {x y : ℝ}

-- demonstrate `split`

example (h₀ : x ≤ y) (h₁ : ¬ y ≤ x) : x ≤ y ∧ x ≠ y :=
sorry

-- demonstrate `cases`, `h.1`, `h.2`

example (h : x ≤ y ∧ x ≠ y) : ¬ y ≤ x :=
sorry

end

/-!
### Disjunction
-/

section

variables x y : ℝ

#check le_or_gt 0 y
#check @abs_of_nonneg
#check @abs_of_neg

example : x < abs y → x < y ∨ x < -y :=
sorry

end

/-!
### Final note

I haven't done everything! In particular, I skipped bi-implication, `true`, `false`,
proof by contradiction, and more.

But this should get you started, and you can consult the resources for more.
-/


/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro, Johannes Hölzl, Patrick Massot

! This file was ported from Lean 3 source module data.set.prod
! leanprover-community/mathlib commit 27f315c5591c84687852f816d8ef31fe103d03de
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Set.Image

/-!
# Sets in product and pi types

This file defines the product of sets in `α × β` and in `Π i, α i` along with the diagonal of a
type.

## Main declarations

* `Set.prod`: Binary product of sets. For `s : Set α`, `t : Set β`, we have
  `s.prod t : Set (α × β)`.
* `Set.diagonal`: Diagonal of a type. `Set.diagonal α = {(x, x) | x : α}`.
* `Set.offDiag`: Off-diagonal. `s ×ˢ s` without the diagonal.
* `Set.pi`: Arbitrary product of sets.
-/

open Function

namespace Set

/-! ### Cartesian binary product of sets -/

section Prod

variable {α β γ δ : Type _} {s s₁ s₂ : Set α} {t t₁ t₂ : Set β} {a : α} {b : β}

/-- The cartesian product `prod s t` is the set of `(a, b)` such that `a ∈ s` and `b ∈ t`. -/
def prod (s : Set α) (t : Set β) : Set (α × β) :=
  { p | p.1 ∈ s ∧ p.2 ∈ t }
#align set.prod Set.prod

-- This notation binds more strongly than (pre)images, unions and intersections.
/-- The cartesian product `s ×ˢ t` is the set of `(a, b)` such that `a ∈ s` and `b ∈ t`. -/
infixr:82 " ×ˢ " => Set.prod

theorem prod_eq (s : Set α) (t : Set β) : s ×ˢ t = Prod.fst ⁻¹' s ∩ Prod.snd ⁻¹' t :=
  rfl
#align set.prod_eq Set.prod_eq

theorem mem_prod_eq {p : α × β} : (p ∈ s ×ˢ t) = (p.1 ∈ s ∧ p.2 ∈ t) :=
  rfl
#align set.mem_prod_eq Set.mem_prod_eq

@[simp]
theorem mem_prod {p : α × β} : p ∈ s ×ˢ t ↔ p.1 ∈ s ∧ p.2 ∈ t :=
  Iff.rfl
#align set.mem_prod Set.mem_prod

-- Porting note: Removing `simp` as `simp` can prove it
theorem prod_mk_mem_set_prod_eq : ((a, b) ∈ s ×ˢ t) = (a ∈ s ∧ b ∈ t) :=
  rfl
#align set.prod_mk_mem_set_prod_eq Set.prod_mk_mem_set_prod_eq

theorem mk_mem_prod (ha : a ∈ s) (hb : b ∈ t) : (a, b) ∈ s ×ˢ t :=
  ⟨ha, hb⟩
#align set.mk_mem_prod Set.mk_mem_prod

noncomputable instance decidableMemProd [DecidablePred (· ∈ s)] [DecidablePred (· ∈ t)] :
    DecidablePred (· ∈ s ×ˢ t) := fun _ => And.decidable
#align set.decidable_mem_prod Set.decidableMemProd

theorem prod_mono (hs : s₁ ⊆ s₂) (ht : t₁ ⊆ t₂) : s₁ ×ˢ t₁ ⊆ s₂ ×ˢ t₂ :=
  fun _ ⟨h₁, h₂⟩ => ⟨hs h₁, ht h₂⟩
#align set.prod_mono Set.prod_mono

theorem prod_mono_left (hs : s₁ ⊆ s₂) : s₁ ×ˢ t ⊆ s₂ ×ˢ t :=
  prod_mono hs Subset.rfl
#align set.prod_mono_left Set.prod_mono_left

theorem prod_mono_right (ht : t₁ ⊆ t₂) : s ×ˢ t₁ ⊆ s ×ˢ t₂ :=
  prod_mono Subset.rfl ht
#align set.prod_mono_right Set.prod_mono_right

@[simp]
theorem prod_self_subset_prod_self : s₁ ×ˢ s₁ ⊆ s₂ ×ˢ s₂ ↔ s₁ ⊆ s₂ :=
  ⟨fun h _ hx => (h (mk_mem_prod hx hx)).1, fun h _ hx => ⟨h hx.1, h hx.2⟩⟩
#align set.prod_self_subset_prod_self Set.prod_self_subset_prod_self

@[simp]
theorem prod_self_ssubset_prod_self : s₁ ×ˢ s₁ ⊂ s₂ ×ˢ s₂ ↔ s₁ ⊂ s₂ :=
  and_congr prod_self_subset_prod_self <| not_congr prod_self_subset_prod_self
#align set.prod_self_ssubset_prod_self Set.prod_self_ssubset_prod_self

theorem prod_subset_iff {P : Set (α × β)} : s ×ˢ t ⊆ P ↔ ∀ x ∈ s, ∀ y ∈ t, (x, y) ∈ P :=
  ⟨fun h _ hx _ hy => h (mk_mem_prod hx hy), fun h ⟨_, _⟩ hp => h _ hp.1 _ hp.2⟩
#align set.prod_subset_iff Set.prod_subset_iff

theorem forall_prod_set {p : α × β → Prop} : (∀ x ∈ s ×ˢ t, p x) ↔ ∀ x ∈ s, ∀ y ∈ t, p (x, y) :=
  prod_subset_iff
#align set.forall_prod_set Set.forall_prod_set

theorem exists_prod_set {p : α × β → Prop} : (∃ x ∈ s ×ˢ t, p x) ↔ ∃ x ∈ s, ∃ y ∈ t, p (x, y) := by
  simp [and_assoc]
#align set.exists_prod_set Set.exists_prod_set

@[simp]
theorem prod_empty : s ×ˢ (∅ : Set β) = ∅ := by
  ext
  exact and_false_iff _
#align set.prod_empty Set.prod_empty

@[simp]
theorem empty_prod : (∅ : Set α) ×ˢ t = ∅ := by
  ext
  exact false_and_iff _
#align set.empty_prod Set.empty_prod

@[simp]
theorem univ_prod_univ : @univ α ×ˢ @univ β = univ := by
  ext
  exact true_and_iff _
#align set.univ_prod_univ Set.univ_prod_univ

theorem univ_prod {t : Set β} : (univ : Set α) ×ˢ t = Prod.snd ⁻¹' t := by simp [prod_eq]
#align set.univ_prod Set.univ_prod

theorem prod_univ {s : Set α} : s ×ˢ (univ : Set β) = Prod.fst ⁻¹' s := by simp [prod_eq]
#align set.prod_univ Set.prod_univ

@[simp]
theorem singleton_prod : ({a} : Set α) ×ˢ t = Prod.mk a '' t := by
  ext ⟨x, y⟩
  simp [and_left_comm, eq_comm]
#align set.singleton_prod Set.singleton_prod

@[simp]
theorem prod_singleton : s ×ˢ ({b} : Set β) = (fun a => (a, b)) '' s := by
  ext ⟨x, y⟩
  simp [and_left_comm, eq_comm]
#align set.prod_singleton Set.prod_singleton

theorem singleton_prod_singleton : ({a} : Set α) ×ˢ ({b} : Set β) = {(a, b)} := by simp
#align set.singleton_prod_singleton Set.singleton_prod_singleton

@[simp]
theorem union_prod : (s₁ ∪ s₂) ×ˢ t = s₁ ×ˢ t ∪ s₂ ×ˢ t := by
  ext ⟨x, y⟩
  simp [or_and_right]
#align set.union_prod Set.union_prod

@[simp]
theorem prod_union : s ×ˢ (t₁ ∪ t₂) = s ×ˢ t₁ ∪ s ×ˢ t₂ := by
  ext ⟨x, y⟩
  simp [and_or_left]
#align set.prod_union Set.prod_union

theorem inter_prod : (s₁ ∩ s₂) ×ˢ t = s₁ ×ˢ t ∩ s₂ ×ˢ t := by
  ext ⟨x, y⟩
  simp only [← and_and_right, mem_inter_iff, mem_prod]
#align set.inter_prod Set.inter_prod

theorem prod_inter : s ×ˢ (t₁ ∩ t₂) = s ×ˢ t₁ ∩ s ×ˢ t₂ := by
  ext ⟨x, y⟩
  simp only [← and_and_left, mem_inter_iff, mem_prod]
#align set.prod_inter Set.prod_inter

theorem prod_inter_prod : s₁ ×ˢ t₁ ∩ s₂ ×ˢ t₂ = (s₁ ∩ s₂) ×ˢ (t₁ ∩ t₂) := by
  ext ⟨x, y⟩
  simp [and_assoc, and_left_comm]
#align set.prod_inter_prod Set.prod_inter_prod

theorem disjoint_prod : Disjoint (s₁ ×ˢ t₁) (s₂ ×ˢ t₂) ↔ Disjoint s₁ s₂ ∨ Disjoint t₁ t₂ := by
  simp_rw [disjoint_left, mem_prod, not_and_or, Prod.forall, and_imp, ← @forall_or_right α, ←
    @forall_or_left β, ← @forall_or_right (_ ∈ s₁), ← @forall_or_left (_ ∈ t₁)]
#align set.disjoint_prod Set.disjoint_prod

theorem insert_prod : insert a s ×ˢ t = Prod.mk a '' t ∪ s ×ˢ t := by
  ext ⟨x, y⟩
  simp (config := { contextual := true }) [image, iff_def, or_imp, Imp.swap]
#align set.insert_prod Set.insert_prod

theorem prod_insert : s ×ˢ insert b t = (fun a => (a, b)) '' s ∪ s ×ˢ t := by
  ext ⟨x, y⟩
  -- Porting note: was `simp (config := { contextual := true }) [image, iff_def, or_imp, Imp.swap]`
  simp [image, or_imp]
  refine ⟨fun h => ?_, fun h => ?_⟩
  · obtain ⟨hx, rfl|hy⟩ := h
    · exact Or.inl ⟨x, hx, rfl, rfl⟩
    · exact Or.inr ⟨hx, hy⟩
  · obtain ⟨x, hx, rfl, rfl⟩|⟨hx, hy⟩ := h
    · exact ⟨hx, Or.inl rfl⟩
    · exact ⟨hx, Or.inr hy⟩
#align set.prod_insert Set.prod_insert

theorem prod_preimage_eq {f : γ → α} {g : δ → β} :
    (f ⁻¹' s) ×ˢ (g ⁻¹' t) = (fun p : γ × δ => (f p.1, g p.2)) ⁻¹' s ×ˢ t :=
  rfl
#align set.prod_preimage_eq Set.prod_preimage_eq

theorem prod_preimage_left {f : γ → α} :
    (f ⁻¹' s) ×ˢ t = (fun p : γ × β => (f p.1, p.2)) ⁻¹' s ×ˢ t :=
  rfl
#align set.prod_preimage_left Set.prod_preimage_left

theorem prod_preimage_right {g : δ → β} :
    s ×ˢ (g ⁻¹' t) = (fun p : α × δ => (p.1, g p.2)) ⁻¹' s ×ˢ t :=
  rfl
#align set.prod_preimage_right Set.prod_preimage_right

theorem preimage_prod_map_prod (f : α → β) (g : γ → δ) (s : Set β) (t : Set δ) :
    Prod.map f g ⁻¹' s ×ˢ t = (f ⁻¹' s) ×ˢ (g ⁻¹' t) :=
  rfl
#align set.preimage_prod_map_prod Set.preimage_prod_map_prod

theorem mk_preimage_prod (f : γ → α) (g : γ → β) :
    (fun x => (f x, g x)) ⁻¹' s ×ˢ t = f ⁻¹' s ∩ g ⁻¹' t :=
  rfl
#align set.mk_preimage_prod Set.mk_preimage_prod

@[simp]
theorem mk_preimage_prod_left (hb : b ∈ t) : (fun a => (a, b)) ⁻¹' s ×ˢ t = s := by
  ext a
  simp [hb]
#align set.mk_preimage_prod_left Set.mk_preimage_prod_left

@[simp]
theorem mk_preimage_prod_right (ha : a ∈ s) : Prod.mk a ⁻¹' s ×ˢ t = t := by
  ext b
  simp [ha]
#align set.mk_preimage_prod_right Set.mk_preimage_prod_right

@[simp]
theorem mk_preimage_prod_left_eq_empty (hb : b ∉ t) : (fun a => (a, b)) ⁻¹' s ×ˢ t = ∅ := by
  ext a
  simp [hb]
#align set.mk_preimage_prod_left_eq_empty Set.mk_preimage_prod_left_eq_empty

@[simp]
theorem mk_preimage_prod_right_eq_empty (ha : a ∉ s) : Prod.mk a ⁻¹' s ×ˢ t = ∅ := by
  ext b
  simp [ha]
#align set.mk_preimage_prod_right_eq_empty Set.mk_preimage_prod_right_eq_empty

theorem mk_preimage_prod_left_eq_if [DecidablePred (· ∈ t)] :
    (fun a => (a, b)) ⁻¹' s ×ˢ t = if b ∈ t then s else ∅ := by split_ifs with h <;> simp [h]
#align set.mk_preimage_prod_left_eq_if Set.mk_preimage_prod_left_eq_if

theorem mk_preimage_prod_right_eq_if [DecidablePred (· ∈ s)] :
    Prod.mk a ⁻¹' s ×ˢ t = if a ∈ s then t else ∅ := by split_ifs with h <;> simp [h]
#align set.mk_preimage_prod_right_eq_if Set.mk_preimage_prod_right_eq_if

theorem mk_preimage_prod_left_fn_eq_if [DecidablePred (· ∈ t)] (f : γ → α) :
    (fun a => (f a, b)) ⁻¹' s ×ˢ t = if b ∈ t then f ⁻¹' s else ∅ := by
  rw [← mk_preimage_prod_left_eq_if, prod_preimage_left, preimage_preimage]
#align set.mk_preimage_prod_left_fn_eq_if Set.mk_preimage_prod_left_fn_eq_if

theorem mk_preimage_prod_right_fn_eq_if [DecidablePred (· ∈ s)] (g : δ → β) :
    (fun b => (a, g b)) ⁻¹' s ×ˢ t = if a ∈ s then g ⁻¹' t else ∅ := by
  rw [← mk_preimage_prod_right_eq_if, prod_preimage_right, preimage_preimage]
#align set.mk_preimage_prod_right_fn_eq_if Set.mk_preimage_prod_right_fn_eq_if

@[simp]
theorem preimage_swap_prod (s : Set α) (t : Set β) : Prod.swap ⁻¹' s ×ˢ t = t ×ˢ s := by
  ext ⟨x, y⟩
  simp [and_comm]
#align set.preimage_swap_prod Set.preimage_swap_prod

@[simp]
theorem image_swap_prod (s : Set α) (t : Set β) : Prod.swap '' s ×ˢ t = t ×ˢ s := by
  rw [image_swap_eq_preimage_swap, preimage_swap_prod]
#align set.image_swap_prod Set.image_swap_prod

theorem prod_range_range_eq {m₁ : α → γ} {m₂ : β → δ} :
    range m₁ ×ˢ range m₂ = range fun p : α × β => (m₁ p.1, m₂ p.2) :=
  ext <| by simp [range]
#align set.prod_range_range_eq Set.prod_range_range_eq

@[simp]
theorem range_prod_map {m₁ : α → γ} {m₂ : β → δ} : range (Prod.map m₁ m₂) = range m₁ ×ˢ range m₂ :=
  prod_range_range_eq.symm
#align set.range_prod_map Set.range_prod_map

theorem prod_range_univ_eq {m₁ : α → γ} :
    range m₁ ×ˢ (univ : Set β) = range fun p : α × β => (m₁ p.1, p.2) :=
  ext <| by simp [range]
#align set.prod_range_univ_eq Set.prod_range_univ_eq

theorem prod_univ_range_eq {m₂ : β → δ} :
    (univ : Set α) ×ˢ range m₂ = range fun p : α × β => (p.1, m₂ p.2) :=
  ext <| by simp [range]
#align set.prod_univ_range_eq Set.prod_univ_range_eq

theorem range_pair_subset (f : α → β) (g : α → γ) :
    (range fun x => (f x, g x)) ⊆ range f ×ˢ range g := by
  have : (fun x => (f x, g x)) = Prod.map f g ∘ fun x => (x, x) := funext fun x => rfl
  rw [this, ← range_prod_map]
  apply range_comp_subset_range
#align set.range_pair_subset Set.range_pair_subset

theorem Nonempty.prod : s.Nonempty → t.Nonempty → (s ×ˢ t).Nonempty := fun ⟨x, hx⟩ ⟨y, hy⟩ =>
  ⟨(x, y), ⟨hx, hy⟩⟩
#align set.nonempty.prod Set.Nonempty.prod

theorem Nonempty.fst : (s ×ˢ t).Nonempty → s.Nonempty := fun ⟨x, hx⟩ => ⟨x.1, hx.1⟩
#align set.nonempty.fst Set.Nonempty.fst

theorem Nonempty.snd : (s ×ˢ t).Nonempty → t.Nonempty := fun ⟨x, hx⟩ => ⟨x.2, hx.2⟩
#align set.nonempty.snd Set.Nonempty.snd

theorem prod_nonempty_iff : (s ×ˢ t).Nonempty ↔ s.Nonempty ∧ t.Nonempty :=
  ⟨fun h => ⟨h.fst, h.snd⟩, fun h => h.1.prod h.2⟩
#align set.prod_nonempty_iff Set.prod_nonempty_iff

theorem prod_eq_empty_iff : s ×ˢ t = ∅ ↔ s = ∅ ∨ t = ∅ := by
  simp only [not_nonempty_iff_eq_empty.symm, prod_nonempty_iff, not_and_or]
#align set.prod_eq_empty_iff Set.prod_eq_empty_iff

theorem prod_sub_preimage_iff {W : Set γ} {f : α × β → γ} :
    s ×ˢ t ⊆ f ⁻¹' W ↔ ∀ a b, a ∈ s → b ∈ t → f (a, b) ∈ W := by simp [subset_def]
#align set.prod_sub_preimage_iff Set.prod_sub_preimage_iff

theorem image_prod_mk_subset_prod {f : α → β} {g : α → γ} {s : Set α} :
    (fun x => (f x, g x)) '' s ⊆ (f '' s) ×ˢ (g '' s) := by
  rintro _ ⟨x, hx, rfl⟩
  exact mk_mem_prod (mem_image_of_mem f hx) (mem_image_of_mem g hx)
#align set.image_prod_mk_subset_prod Set.image_prod_mk_subset_prod

theorem image_prod_mk_subset_prod_left (hb : b ∈ t) : (fun a => (a, b)) '' s ⊆ s ×ˢ t := by
  rintro _ ⟨a, ha, rfl⟩
  exact ⟨ha, hb⟩
#align set.image_prod_mk_subset_prod_left Set.image_prod_mk_subset_prod_left

theorem image_prod_mk_subset_prod_right (ha : a ∈ s) : Prod.mk a '' t ⊆ s ×ˢ t := by
  rintro _ ⟨b, hb, rfl⟩
  exact ⟨ha, hb⟩
#align set.image_prod_mk_subset_prod_right Set.image_prod_mk_subset_prod_right

theorem prod_subset_preimage_fst (s : Set α) (t : Set β) : s ×ˢ t ⊆ Prod.fst ⁻¹' s :=
  inter_subset_left _ _
#align set.prod_subset_preimage_fst Set.prod_subset_preimage_fst

theorem fst_image_prod_subset (s : Set α) (t : Set β) : Prod.fst '' s ×ˢ t ⊆ s :=
  image_subset_iff.2 <| prod_subset_preimage_fst s t
#align set.fst_image_prod_subset Set.fst_image_prod_subset

theorem fst_image_prod (s : Set β) {t : Set α} (ht : t.Nonempty) : Prod.fst '' s ×ˢ t = s :=
  (fst_image_prod_subset _ _).antisymm fun y hy =>
    let ⟨x, hx⟩ := ht
    ⟨(y, x), ⟨hy, hx⟩, rfl⟩
#align set.fst_image_prod Set.fst_image_prod

theorem prod_subset_preimage_snd (s : Set α) (t : Set β) : s ×ˢ t ⊆ Prod.snd ⁻¹' t :=
  inter_subset_right _ _
#align set.prod_subset_preimage_snd Set.prod_subset_preimage_snd

theorem snd_image_prod_subset (s : Set α) (t : Set β) : Prod.snd '' s ×ˢ t ⊆ t :=
  image_subset_iff.2 <| prod_subset_preimage_snd s t
#align set.snd_image_prod_subset Set.snd_image_prod_subset

theorem snd_image_prod {s : Set α} (hs : s.Nonempty) (t : Set β) : Prod.snd '' s ×ˢ t = t :=
  (snd_image_prod_subset _ _).antisymm fun y y_in =>
    let ⟨x, x_in⟩ := hs
    ⟨(x, y), ⟨x_in, y_in⟩, rfl⟩
#align set.snd_image_prod Set.snd_image_prod

theorem prod_diff_prod : s ×ˢ t \ s₁ ×ˢ t₁ = s ×ˢ (t \ t₁) ∪ (s \ s₁) ×ˢ t := by
  ext x
  by_cases h₁ : x.1 ∈ s₁ <;> by_cases h₂ : x.2 ∈ t₁ <;> simp [*]
#align set.prod_diff_prod Set.prod_diff_prod

/-- A product set is included in a product set if and only factors are included, or a factor of the
first set is empty. -/
theorem prod_subset_prod_iff : s ×ˢ t ⊆ s₁ ×ˢ t₁ ↔ s ⊆ s₁ ∧ t ⊆ t₁ ∨ s = ∅ ∨ t = ∅ := by
  cases' (s ×ˢ t).eq_empty_or_nonempty with h h
  · simp [h, prod_eq_empty_iff.1 h]
  have st : s.Nonempty ∧ t.Nonempty := by rwa [prod_nonempty_iff] at h
  refine' ⟨fun H => Or.inl ⟨_, _⟩, _⟩
  · have := image_subset (Prod.fst : α × β → α) H
    rwa [fst_image_prod _ st.2, fst_image_prod _ (h.mono H).snd] at this
  · have := image_subset (Prod.snd : α × β → β) H
    rwa [snd_image_prod st.1, snd_image_prod (h.mono H).fst] at this
  · intro H
    simp only [st.1.ne_empty, st.2.ne_empty, or_false_iff] at H
    exact prod_mono H.1 H.2
#align set.prod_subset_prod_iff Set.prod_subset_prod_iff

theorem prod_eq_prod_iff_of_nonempty (h : (s ×ˢ t).Nonempty) :
    s ×ˢ t = s₁ ×ˢ t₁ ↔ s = s₁ ∧ t = t₁ := by
  constructor
  · intro heq
    have h₁ : (s₁ ×ˢ t₁ : Set _).Nonempty := by rwa [← heq]
    rw [prod_nonempty_iff] at h h₁
    rw [← fst_image_prod s h.2, ← fst_image_prod s₁ h₁.2, heq, eq_self_iff_true, true_and_iff, ←
      snd_image_prod h.1 t, ← snd_image_prod h₁.1 t₁, heq]
  · rintro ⟨rfl, rfl⟩
    rfl
#align set.prod_eq_prod_iff_of_nonempty Set.prod_eq_prod_iff_of_nonempty

theorem prod_eq_prod_iff :
    s ×ˢ t = s₁ ×ˢ t₁ ↔ s = s₁ ∧ t = t₁ ∨ (s = ∅ ∨ t = ∅) ∧ (s₁ = ∅ ∨ t₁ = ∅) := by
  symm
  cases' eq_empty_or_nonempty (s ×ˢ t) with h h
  · simp_rw [h, @eq_comm _ ∅, prod_eq_empty_iff, prod_eq_empty_iff.mp h, true_and_iff,
      or_iff_right_iff_imp]
    rintro ⟨rfl, rfl⟩
    exact prod_eq_empty_iff.mp h
  rw [prod_eq_prod_iff_of_nonempty h]
  rw [nonempty_iff_ne_empty, Ne.def, prod_eq_empty_iff] at h
  simp_rw [h, false_and_iff, or_false_iff]
#align set.prod_eq_prod_iff Set.prod_eq_prod_iff

@[simp]
theorem prod_eq_iff_eq (ht : t.Nonempty) : s ×ˢ t = s₁ ×ˢ t ↔ s = s₁ := by
  simp_rw [prod_eq_prod_iff, ht.ne_empty, eq_self_iff_true, and_true_iff, or_iff_left_iff_imp,
    or_false_iff]
  rintro ⟨rfl, rfl⟩
  rfl
#align set.prod_eq_iff_eq Set.prod_eq_iff_eq

section Mono

variable [Preorder α] {f : α → Set β} {g : α → Set γ}

theorem _root_.Monotone.set_prod (hf : Monotone f) (hg : Monotone g) :
    Monotone fun x => f x ×ˢ g x :=
  fun _ _ h => prod_mono (hf h) (hg h)
#align monotone.set_prod Monotone.set_prod

theorem _root_.Antitone.set_prod (hf : Antitone f) (hg : Antitone g) :
    Antitone fun x => f x ×ˢ g x :=
  fun _ _ h => prod_mono (hf h) (hg h)
#align antitone.set_prod Antitone.set_prod

theorem _root_.MonotoneOn.set_prod (hf : MonotoneOn f s) (hg : MonotoneOn g s) :
    MonotoneOn (fun x => f x ×ˢ g x) s := fun _ ha _ hb h => prod_mono (hf ha hb h) (hg ha hb h)
#align monotone_on.set_prod MonotoneOn.set_prod

theorem _root_.AntitoneOn.set_prod (hf : AntitoneOn f s) (hg : AntitoneOn g s) :
    AntitoneOn (fun x => f x ×ˢ g x) s := fun _ ha _ hb h => prod_mono (hf ha hb h) (hg ha hb h)
#align antitone_on.set_prod AntitoneOn.set_prod

end Mono

end Prod

/-! ### Diagonal

In this section we prove some lemmas about the diagonal set `{p | p.1 = p.2}` and the diagonal map
`λ x, (x, x)`.
-/

section Diagonal

variable {α : Type _} {s t : Set α}

/-- `diagonal α` is the set of `α × α` consisting of all pairs of the form `(a, a)`. -/
def diagonal (α : Type _) : Set (α × α) :=
  { p | p.1 = p.2 }
#align set.diagonal Set.diagonal

theorem mem_diagonal (x : α) : (x, x) ∈ diagonal α := by simp [diagonal]
#align set.mem_diagonal Set.mem_diagonal

@[simp]
theorem mem_diagonal_iff {x : α × α} : x ∈ diagonal α ↔ x.1 = x.2 :=
  Iff.rfl
#align set.mem_diagonal_iff Set.mem_diagonal_iff

lemma diagonal_nonempty [Nonempty α] : (diagonal α).Nonempty :=
Nonempty.elim ‹_› <| fun x => ⟨_, mem_diagonal x⟩
#align set.diagonal_nonempty Set.diagonal_nonempty

instance decidableMemDiagonal [h : DecidableEq α] (x : α × α) : Decidable (x ∈ diagonal α) :=
  h x.1 x.2
#align set.decidable_mem_diagonal Set.decidableMemDiagonal

theorem preimage_coe_coe_diagonal (s : Set α) :
    Prod.map (fun x : s => (x : α)) (fun x : s => (x : α)) ⁻¹' diagonal α = diagonal s := by
  ext ⟨⟨x, hx⟩, ⟨y, hy⟩⟩
  simp [Set.diagonal]
#align set.preimage_coe_coe_diagonal Set.preimage_coe_coe_diagonal

@[simp]
theorem range_diag : (range fun x => (x, x)) = diagonal α := by
  ext ⟨x, y⟩
  simp [diagonal, eq_comm]
#align set.range_diag Set.range_diag

theorem diagonal_subset_iff {s} : diagonal α ⊆ s ↔ ∀ x, (x, x) ∈ s := by
  rw [← range_diag, range_subset_iff]
#align set.diagonal_subset_iff Set.diagonal_subset_iff

@[simp]
theorem prod_subset_compl_diagonal_iff_disjoint : s ×ˢ t ⊆ diagonal αᶜ ↔ Disjoint s t :=
  prod_subset_iff.trans disjoint_iff_forall_ne.symm
#align set.prod_subset_compl_diagonal_iff_disjoint Set.prod_subset_compl_diagonal_iff_disjoint

@[simp]
theorem diag_preimage_prod (s t : Set α) : (fun x => (x, x)) ⁻¹' s ×ˢ t = s ∩ t :=
  rfl
#align set.diag_preimage_prod Set.diag_preimage_prod

theorem diag_preimage_prod_self (s : Set α) : (fun x => (x, x)) ⁻¹' s ×ˢ s = s :=
  inter_self s
#align set.diag_preimage_prod_self Set.diag_preimage_prod_self

theorem diag_image (s : Set α) : (fun x => (x, x)) '' s = diagonal α ∩ s ×ˢ s := by
  ext x
  constructor
  · rintro ⟨x, hx, rfl⟩
    exact ⟨rfl, hx, hx⟩
  · obtain ⟨x, y⟩ := x
    rintro ⟨rfl : x = y, h2x⟩
    exact mem_image_of_mem _ h2x.1
#align set.diag_image Set.diag_image

end Diagonal

section OffDiag

variable {α : Type _} {s t : Set α} {x : α × α} {a : α}

/-- The off-diagonal of a set `s` is the set of pairs `(a, b)` with `a, b ∈ s` and `a ≠ b`. -/
def offDiag (s : Set α) : Set (α × α) :=
  { x | x.1 ∈ s ∧ x.2 ∈ s ∧ x.1 ≠ x.2 }
#align set.off_diag Set.offDiag

@[simp]
theorem mem_offDiag : x ∈ s.offDiag ↔ x.1 ∈ s ∧ x.2 ∈ s ∧ x.1 ≠ x.2 :=
  Iff.rfl
#align set.mem_off_diag Set.mem_offDiag

theorem offDiag_mono : Monotone (offDiag : Set α → Set (α × α)) := fun _ _ h _ =>
  And.imp (@h _) <| And.imp_left <| @h _
#align set.off_diag_mono Set.offDiag_mono

@[simp]
theorem offDiag_nonempty : s.offDiag.Nonempty ↔ s.Nontrivial := by
  simp [offDiag, Set.Nonempty, Set.Nontrivial]
#align set.off_diag_nonempty Set.offDiag_nonempty

@[simp]
theorem offDiag_eq_empty : s.offDiag = ∅ ↔ s.Subsingleton := by
  rw [← not_nonempty_iff_eq_empty, ← not_nontrivial_iff, offDiag_nonempty.not]
#align set.off_diag_eq_empty Set.offDiag_eq_empty

alias offDiag_nonempty ↔ _ Nontrivial.offDiag_nonempty
#align set.nontrivial.off_diag_nonempty Set.Nontrivial.offDiag_nonempty

alias offDiag_nonempty ↔ _ Subsingleton.offDiag_eq_empty
#align set.subsingleton.off_diag_eq_empty Set.Subsingleton.offDiag_eq_empty

variable (s t)

theorem offDiag_subset_prod : s.offDiag ⊆ s ×ˢ s := fun _ hx => ⟨hx.1, hx.2.1⟩
#align set.off_diag_subset_prod Set.offDiag_subset_prod

theorem offDiag_eq_sep_prod : s.offDiag = { x ∈ s ×ˢ s | x.1 ≠ x.2 } :=
  ext fun _ => and_assoc.symm
#align set.off_diag_eq_sep_prod Set.offDiag_eq_sep_prod

@[simp]
theorem offDiag_empty : (∅ : Set α).offDiag = ∅ := by simp
#align set.off_diag_empty Set.offDiag_empty

@[simp]
theorem offDiag_singleton (a : α) : ({a} : Set α).offDiag = ∅ := by simp
#align set.off_diag_singleton Set.offDiag_singleton

@[simp]
theorem offDiag_univ : (univ : Set α).offDiag = diagonal αᶜ :=
  ext <| by simp
#align set.off_diag_univ Set.offDiag_univ

@[simp]
theorem prod_sdiff_diagonal : s ×ˢ s \ diagonal α = s.offDiag :=
  ext fun _ => and_assoc
#align set.prod_sdiff_diagonal Set.prod_sdiff_diagonal

@[simp]
theorem disjoint_diagonal_offDiag : Disjoint (diagonal α) s.offDiag :=
  disjoint_left.mpr fun _ hd ho => ho.2.2 hd
#align set.disjoint_diagonal_off_diag Set.disjoint_diagonal_offDiag

theorem offDiag_inter : (s ∩ t).offDiag = s.offDiag ∩ t.offDiag :=
  ext fun x => by
    simp only [mem_offDiag, mem_inter_iff]
    tauto
#align set.off_diag_inter Set.offDiag_inter

variable {s t}

theorem offDiag_union (h : Disjoint s t) :
    (s ∪ t).offDiag = s.offDiag ∪ t.offDiag ∪ s ×ˢ t ∪ t ×ˢ s := by
  ext x
  simp only [mem_offDiag, mem_union, ne_eq, mem_prod]
  constructor
  · rintro ⟨h0|h0, h1|h1, h2⟩ <;> simp [h0, h1, h2]
  · rintro (((⟨h0, h1, h2⟩|⟨h0, h1, h2⟩)|⟨h0, h1⟩)|⟨h0, h1⟩) <;> simp [*]
    · rintro h3
      rw [h3] at h0
      exact (Set.disjoint_left.mp h h0 h1)
    · rintro h3
      rw [h3] at h0
      exact (Set.disjoint_right.mp h h0 h1).elim
#align set.off_diag_union Set.offDiag_union

theorem offDiag_insert (ha : a ∉ s) : (insert a s).offDiag = s.offDiag ∪ {a} ×ˢ s ∪ s ×ˢ {a} := by
  rw [insert_eq, union_comm, offDiag_union, offDiag_singleton, union_empty, union_right_comm]
  rw [disjoint_left]
  rintro b hb (rfl : b = a)
  exact ha hb
#align set.off_diag_insert Set.offDiag_insert

end OffDiag

/-! ### Cartesian set-indexed product of sets -/

section Pi

variable {ι : Type _} {α β : ι → Type _} {s s₁ s₂ : Set ι} {t t₁ t₂ : ∀ i, Set (α i)} {i : ι}

/-- Given an index set `ι` and a family of sets `t : Π i, set (α i)`, `pi s t`
is the set of dependent functions `f : Πa, π a` such that `f a` belongs to `t a`
whenever `a ∈ s`. -/
def pi (s : Set ι) (t : ∀ i, Set (α i)) : Set (∀ i, α i) :=
  { f | ∀ i ∈ s, f i ∈ t i }
#align set.pi Set.pi

@[simp]
theorem mem_pi {f : ∀ i, α i} : f ∈ s.pi t ↔ ∀ i ∈ s, f i ∈ t i :=
  Iff.rfl
#align set.mem_pi Set.mem_pi

-- Porting note: Removing `simp` as `simp` can prove it
theorem mem_univ_pi {f : ∀ i, α i} : f ∈ pi univ t ↔ ∀ i, f i ∈ t i := by simp
#align set.mem_univ_pi Set.mem_univ_pi

@[simp]
theorem empty_pi (s : ∀ i, Set (α i)) : pi ∅ s = univ := by
  ext
  simp [pi]
#align set.empty_pi Set.empty_pi

@[simp]
theorem pi_univ (s : Set ι) : (pi s fun i => (univ : Set (α i))) = univ :=
  eq_univ_of_forall fun _ _ _ => mem_univ _
#align set.pi_univ Set.pi_univ

theorem pi_mono (h : ∀ i ∈ s, t₁ i ⊆ t₂ i) : pi s t₁ ⊆ pi s t₂ := fun _ hx i hi => h i hi <| hx i hi
#align set.pi_mono Set.pi_mono

theorem pi_inter_distrib : (s.pi fun i => t i ∩ t₁ i) = s.pi t ∩ s.pi t₁ :=
  ext fun x => by simp only [forall_and, mem_pi, mem_inter_iff]
#align set.pi_inter_distrib Set.pi_inter_distrib

theorem pi_congr (h : s₁ = s₂) (h' : ∀ i ∈ s₁, t₁ i = t₂ i) : s₁.pi t₁ = s₂.pi t₂ :=
  h ▸ ext fun _ => forall₂_congr fun i hi => h' i hi ▸ Iff.rfl
#align set.pi_congr Set.pi_congr

theorem pi_eq_empty (hs : i ∈ s) (ht : t i = ∅) : s.pi t = ∅ := by
  ext f
  simp only [mem_empty_iff_false, not_forall, iff_false_iff, mem_pi, not_imp]
  exact ⟨i, hs, by simp [ht]⟩
#align set.pi_eq_empty Set.pi_eq_empty

theorem univ_pi_eq_empty (ht : t i = ∅) : pi univ t = ∅ :=
  pi_eq_empty (mem_univ i) ht
#align set.univ_pi_eq_empty Set.univ_pi_eq_empty

theorem pi_nonempty_iff : (s.pi t).Nonempty ↔ ∀ i, ∃ x, i ∈ s → x ∈ t i := by
  simp [Classical.skolem, Set.Nonempty]
#align set.pi_nonempty_iff Set.pi_nonempty_iff

theorem univ_pi_nonempty_iff : (pi univ t).Nonempty ↔ ∀ i, (t i).Nonempty := by
  simp [Classical.skolem, Set.Nonempty]
#align set.univ_pi_nonempty_iff Set.univ_pi_nonempty_iff

theorem pi_eq_empty_iff : s.pi t = ∅ ↔ ∃ i, IsEmpty (α i) ∨ i ∈ s ∧ t i = ∅ := by
  rw [← not_nonempty_iff_eq_empty, pi_nonempty_iff]
  push_neg
  refine' exists_congr fun i => _
  cases isEmpty_or_nonempty (α i) <;> simp [*, forall_and, eq_empty_iff_forall_not_mem]
#align set.pi_eq_empty_iff Set.pi_eq_empty_iff

@[simp]
theorem univ_pi_eq_empty_iff : pi univ t = ∅ ↔ ∃ i, t i = ∅ := by
  simp [← not_nonempty_iff_eq_empty, univ_pi_nonempty_iff]
#align set.univ_pi_eq_empty_iff Set.univ_pi_eq_empty_iff

@[simp]
theorem univ_pi_empty [h : Nonempty ι] : pi univ (fun _ => ∅ : ∀ i, Set (α i)) = ∅ :=
  univ_pi_eq_empty_iff.2 <| h.elim fun x => ⟨x, rfl⟩
#align set.univ_pi_empty Set.univ_pi_empty

@[simp]
theorem disjoint_univ_pi : Disjoint (pi univ t₁) (pi univ t₂) ↔ ∃ i, Disjoint (t₁ i) (t₂ i) := by
  simp only [disjoint_iff_inter_eq_empty, ← pi_inter_distrib, univ_pi_eq_empty_iff]
#align set.disjoint_univ_pi Set.disjoint_univ_pi

-- Porting note: Removing `simp` - LHS does not simplify
theorem range_dcomp (f : ∀ i, α i → β i) :
    (range fun g : ∀ i, α i => fun i => f i (g i)) = pi univ fun i => range (f i) := by
  refine Subset.antisymm ?_ fun x hx => ?_
  · rintro _ ⟨x, rfl⟩ i -
    exact ⟨x i, rfl⟩
  · choose y hy using hx
    exact ⟨fun i => y i trivial, funext fun i => hy i trivial⟩
#align set.range_dcomp Set.range_dcomp

@[simp]
theorem insert_pi (i : ι) (s : Set ι) (t : ∀ i, Set (α i)) :
    pi (insert i s) t = eval i ⁻¹' t i ∩ pi s t := by
  ext
  simp [pi, or_imp, forall_and]
#align set.insert_pi Set.insert_pi

@[simp]
theorem singleton_pi (i : ι) (t : ∀ i, Set (α i)) : pi {i} t = eval i ⁻¹' t i := by
  ext
  simp [pi]
#align set.singleton_pi Set.singleton_pi

theorem singleton_pi' (i : ι) (t : ∀ i, Set (α i)) : pi {i} t = { x | x i ∈ t i } :=
  singleton_pi i t
#align set.singleton_pi' Set.singleton_pi'

theorem univ_pi_singleton (f : ∀ i, α i) : (pi univ fun i => {f i}) = ({f} : Set (∀ i, α i)) :=
  ext fun g => by simp [funext_iff]
#align set.univ_pi_singleton Set.univ_pi_singleton

theorem preimage_pi (s : Set ι) (t : ∀ i, Set (β i)) (f : ∀ i, α i → β i) :
    (fun (g : ∀ i, α i) i => f _ (g i)) ⁻¹' s.pi t = s.pi fun i => f i ⁻¹' t i :=
  rfl
#align set.preimage_pi Set.preimage_pi

theorem pi_if {p : ι → Prop} [h : DecidablePred p] (s : Set ι) (t₁ t₂ : ∀ i, Set (α i)) :
    (pi s fun i => if p i then t₁ i else t₂ i) =
      pi ({ i ∈ s | p i }) t₁ ∩ pi ({ i ∈ s | ¬p i }) t₂ := by
  ext f
  refine' ⟨fun h => _, _⟩
  · constructor <;>
      · rintro i ⟨his, hpi⟩
        simpa [*] using h i
  · rintro ⟨ht₁, ht₂⟩ i his
    by_cases p i <;> simp_all
#align set.pi_if Set.pi_if

theorem union_pi : (s₁ ∪ s₂).pi t = s₁.pi t ∩ s₂.pi t := by
  simp [pi, or_imp, forall_and, setOf_and]
#align set.union_pi Set.union_pi

@[simp]
theorem pi_inter_compl (s : Set ι) : pi s t ∩ pi (sᶜ) t = pi univ t := by
  rw [← union_pi, union_compl_self]
#align set.pi_inter_compl Set.pi_inter_compl

theorem pi_update_of_not_mem [DecidableEq ι] (hi : i ∉ s) (f : ∀ j, α j) (a : α i)
    (t : ∀ j, α j → Set (β j)) : (s.pi fun j => t j (update f i a j)) = s.pi fun j => t j (f j) :=
  (pi_congr rfl) fun j hj => by
    rw [update_noteq]
    exact fun h => hi (h ▸ hj)
#align set.pi_update_of_not_mem Set.pi_update_of_not_mem

theorem pi_update_of_mem [DecidableEq ι] (hi : i ∈ s) (f : ∀ j, α j) (a : α i)
    (t : ∀ j, α j → Set (β j)) :
    (s.pi fun j => t j (update f i a j)) = { x | x i ∈ t i a } ∩ (s \ {i}).pi fun j => t j (f j) :=
  calc
    (s.pi fun j => t j (update f i a j)) = ({i} ∪ s \ {i}).pi fun j => t j (update f i a j) :=
        by rw [union_diff_self, union_eq_self_of_subset_left (singleton_subset_iff.2 hi)]
    _ = { x | x i ∈ t i a } ∩ (s \ {i}).pi fun j => t j (f j) :=
        by rw [union_pi, singleton_pi', update_same, pi_update_of_not_mem]; simp

#align set.pi_update_of_mem Set.pi_update_of_mem

theorem univ_pi_update [DecidableEq ι] {β : ∀ _, Type _} (i : ι) (f : ∀ j, α j) (a : α i)
    (t : ∀ j, α j → Set (β j)) :
    (pi univ fun j => t j (update f i a j)) = { x | x i ∈ t i a } ∩ pi ({i}ᶜ) fun j => t j (f j) :=
  by rw [compl_eq_univ_diff, ← pi_update_of_mem (mem_univ _)]
#align set.univ_pi_update Set.univ_pi_update

theorem univ_pi_update_univ [DecidableEq ι] (i : ι) (s : Set (α i)) :
    pi univ (update (fun j : ι => (univ : Set (α j))) i s) = eval i ⁻¹' s := by
  rw [univ_pi_update i (fun j => (univ : Set (α j))) s fun j t => t, pi_univ, inter_univ, preimage]
#align set.univ_pi_update_univ Set.univ_pi_update_univ

theorem eval_image_pi_subset (hs : i ∈ s) : eval i '' s.pi t ⊆ t i :=
  image_subset_iff.2 fun _ hf => hf i hs
#align set.eval_image_pi_subset Set.eval_image_pi_subset

theorem eval_image_univ_pi_subset : eval i '' pi univ t ⊆ t i :=
  eval_image_pi_subset (mem_univ i)
#align set.eval_image_univ_pi_subset Set.eval_image_univ_pi_subset

theorem subset_eval_image_pi (ht : (s.pi t).Nonempty) (i : ι) : t i ⊆ eval i '' s.pi t := by
  classical
  obtain ⟨f, hf⟩ := ht
  refine' fun y hy => ⟨update f i y, fun j hj => _, update_same _ _ _⟩
  obtain rfl | hji := eq_or_ne j i <;> simp [*, hf _ hj]
#align set.subset_eval_image_pi Set.subset_eval_image_pi

theorem eval_image_pi (hs : i ∈ s) (ht : (s.pi t).Nonempty) : eval i '' s.pi t = t i :=
  (eval_image_pi_subset hs).antisymm (subset_eval_image_pi ht i)
#align set.eval_image_pi Set.eval_image_pi

@[simp]
theorem eval_image_univ_pi (ht : (pi univ t).Nonempty) :
    (fun f : ∀ i, α i => f i) '' pi univ t = t i :=
  eval_image_pi (mem_univ i) ht
#align set.eval_image_univ_pi Set.eval_image_univ_pi

theorem pi_subset_pi_iff : pi s t₁ ⊆ pi s t₂ ↔ (∀ i ∈ s, t₁ i ⊆ t₂ i) ∨ pi s t₁ = ∅ := by
  refine'
    ⟨fun h => or_iff_not_imp_right.2 _, fun h => h.elim pi_mono fun h' => h'.symm ▸ empty_subset _⟩
  rw [← Ne.def, ← nonempty_iff_ne_empty]
  intro hne i hi
  simpa only [eval_image_pi hi hne, eval_image_pi hi (hne.mono h)] using
    image_subset (fun f : ∀ i, α i => f i) h
#align set.pi_subset_pi_iff Set.pi_subset_pi_iff

theorem univ_pi_subset_univ_pi_iff : pi univ t₁ ⊆ pi univ t₂ ↔ (∀ i, t₁ i ⊆ t₂ i) ∨ ∃ i, t₁ i = ∅ :=
  by simp [pi_subset_pi_iff]
#align set.univ_pi_subset_univ_pi_iff Set.univ_pi_subset_univ_pi_iff

theorem eval_preimage [DecidableEq ι] {s : Set (α i)} :
    eval i ⁻¹' s = pi univ (update (fun i => univ) i s) := by
  ext x
  simp [@forall_update_iff _ (fun i => Set (α i)) _ _ _ _ fun i' y => x i' ∈ y]
#align set.eval_preimage Set.eval_preimage

theorem eval_preimage' [DecidableEq ι] {s : Set (α i)} :
    eval i ⁻¹' s = pi {i} (update (fun i => univ) i s) := by
  ext
  simp
#align set.eval_preimage' Set.eval_preimage'

theorem update_preimage_pi [DecidableEq ι] {f : ∀ i, α i} (hi : i ∈ s)
    (hf : ∀ j ∈ s, j ≠ i → f j ∈ t j) : update f i ⁻¹' s.pi t = t i := by
  ext x
  refine' ⟨fun h => _, fun hx j hj => _⟩
  · convert h i hi
    simp
  · obtain rfl | h := eq_or_ne j i
    · simpa
    · rw [update_noteq h]
      exact hf j hj h
#align set.update_preimage_pi Set.update_preimage_pi

theorem update_preimage_univ_pi [DecidableEq ι] {f : ∀ i, α i} (hf : ∀ (j) (_ : j ≠ i), f j ∈ t j) :
    update f i ⁻¹' pi univ t = t i :=
  update_preimage_pi (mem_univ i) fun j _ => hf j
#align set.update_preimage_univ_pi Set.update_preimage_univ_pi

theorem subset_pi_eval_image (s : Set ι) (u : Set (∀ i, α i)) : u ⊆ pi s fun i => eval i '' u :=
  fun f hf _ _ => ⟨f, hf, rfl⟩
#align set.subset_pi_eval_image Set.subset_pi_eval_image

theorem univ_pi_ite (s : Set ι) [DecidablePred (· ∈ s)] (t : ∀ i, Set (α i)) :
    (pi univ fun i => if i ∈ s then t i else univ) = s.pi t := by
  ext
  simp_rw [mem_univ_pi]
  refine' forall_congr' fun i => _
  split_ifs with h <;> simp [h]
#align set.univ_pi_ite Set.univ_pi_ite

end Pi

end Set