import data.tree
import utilities
import data.nat.pow

set_option trace.simplify.rewrite true

open tree

variable { α : Type}
variable { β : Type}
variable a: α
variables t l r s: tree α
variable f: α → β

/-
## Basic Functions

A binary tree is already defined in Lean as tree.
The difference with __Functional Algorithms, Verified!__ is that a leaf is called nil,
and the order of the node is (α, tree, tree) instead of (tree, α, tree).
Since this does not change the structure of the proofs, the Lean definition is reused.
-/

def set_tree: tree α → set α
| nil := {}
| (node a l r) := set_tree l ∪ {a} ∪ set_tree r

/-
map_tree is already defined in Lean as map and is reused.
-/

def inorder: tree α → list α
| nil := []
| (node a l r) := inorder l ++ [a] ++ inorder r

/-
The name preorder is already used in lean, therefore the name preorder' is used.
-/
def preorder': tree α → list α
| nil := []
| (node a l r) := [a] ++ preorder' l ++ preorder' r

def postorder: tree α → list α
| nil := []
| (node a l r) := postorder l ++ postorder r ++ [a]

def size: tree α → ℕ
| nil := 0
| (node a l r) := size l + size r + 1

def size1: tree α → ℕ
| nil := 1
| (node a l r) := size1 l + size1 r

def height : tree α → ℕ
| nil := 0
| (node a l r) := max (height l) (height r) + 1

def min_height: tree α → ℕ
| nil := 0
| (node a l r) := min (min_height l) (min_height r) + 1

def subtrees: tree α → set (tree α)
| nil := {tree.nil}
| (node a l r) := { (node a l r)} ∪ subtrees l ∪ subtrees r

/-
## Lemmas Size
Except for the first lemma, these lemmas are only in the Isabelle file
-/

lemma size1_size: size1 t = size t + 1 :=
begin
  induction' t,
  repeat { simp [size, size1, *]},
  cc
end

@[simp]
lemma size1_ge0: 0 < size1 t :=
begin
  simp [size1_size],
end

@[simp]
lemma eq_size_0 : size t = 0 ↔ t = nil :=
begin
  cases t,
  repeat { simp [size] },
end

@[simp]
lemma eq_0_size: 0 = size t ↔ t = nil :=
begin
  cases t with a l r,
  repeat { simp [size, nat.add_one, ← ne.def]},
  apply ne.symm,
  simp,
end

/-
This lemma is called __neq_Leaf_iff__ in the Isabelle file.
-/
lemma neq_nil_iff: t ≠ nil ↔ ∃ a l r, t = (node a l r) :=
begin
  cases t with a l r,
  repeat { simp },
end

/-
## Lemmas Height
Some of these lemmas are only in the Isabelle file.
-/

@[simp]
lemma eq_height_0 : height t = 0 ↔ t = nil :=
begin
  cases t,
  repeat { simp [height],},
end

@[simp]
lemma eq_0_height : 0 = height t ↔ t = nil :=
begin
  cases t with a l r,
  repeat { simp [height, nat.add_one, ← ne.def]},
  apply ne.symm,
  simp,
end

@[simp]
lemma height_le_size_tree: height t <= size t :=
begin
  induction' t,
  repeat { simp [height, size] },
  apply and.intro,
  { calc
      height t <= size t : by simp *
      ... ≤ size t + size t_1 :by simp},
  calc
    height t_1 <= size t_1: by simp *
    ... ≤ size t + size t_1 : by simp
end

lemma min_height_le_height : min_height t <= height t:=
begin
  induction' t,
  repeat { simp [height, min_height, *]}
end

lemma size1_height: size1 t <= 2 ^ height t :=
begin
  have h2: 2 <= 2, by trivial,
  induction' t with a l r,
  repeat { simp [size1, height, max_def] },
  split_ifs,
  { have h3: 2 ^ height r <= 2 ^height l, from iff.elim_right (nat.pow_le_iff_le_right h2) h,
    calc
      size1 l + size1 r <= 2 ^ height l + size1 r : by simp *
      ... <= 2 ^ height l + 2 ^ height r  : by simp *
      ... <= 2 ^ height l + 2 ^ height l  : by simp *
      ... = 2 ^ (height l + 1) : by ring },
  have h1: height l <= height r, by linarith,
  have h3: 2 ^ height l <= 2 ^height r, by apply iff.elim_right (nat.pow_le_iff_le_right h2) h1,
  calc
    size1 l + size1 r <= 2 ^ height l + size1 r: by simp *
    ... <= 2 ^ height l + 2 ^ height r : by simp *
    ... <= 2 ^ height r + 2 ^ height r : by simp *
    ... = 2 ^ (height r + 1) : by ring
end

lemma size_height: size t <= 2 ^ height t - 1 :=
begin
  have h: size1 t <= 2 ^ height t, from size1_height t,
  have h1: size1 t = size t + 1, from size1_size t,
  rw h1 at h,
  have h2: 1 <= 2 ^ height t, from nat.one_le_two_pow (height t),
  have h3:size t + 1 ≤ 2 ^ height t ↔ size t ≤ 2 ^ height t - 1, from nat.add_le_to_le_sub (size t) h2,
  exact iff.elim_left h3 h,
end

lemma min_height_size1: 2 ^ min_height t <= size1 t :=
begin
  have h2: 2 <= 2, by trivial,
  induction' t with a l r,
  repeat { simp [min_height, size1, min_def] },
  split_ifs,
  { have h3: 2 ^ min_height l <= 2 ^ min_height r, from iff.elim_right (nat.pow_le_iff_le_right h2) h,
    calc
      2 ^ (min_height l + 1) = 2 ^ min_height l + 2 ^ min_height l : by ring
      ... <= 2 ^ min_height l + 2 ^ min_height r : by simp *
      ... <= size1 l + 2 ^ min_height r: by simp *
      ... <= size1 l + size1 r : by simp * },
  have h1: min_height r <= min_height l, by linarith,
  have h3: 2 ^ min_height r <= 2 ^ min_height l, from iff.elim_right (nat.pow_le_iff_le_right h2) h1,
    calc
      2 ^ (min_height r + 1) = 2 ^ min_height r + 2 ^ min_height r : by ring
      ... <= 2 ^ min_height l + 2 ^ min_height r : by simp *
      ... <= 2 ^ min_height l + size1 r: by simp *
      ... <= size1 l + size1 r : by simp *
end

/-
## Lemmas set_tree
These lemmas are only in the Isabelle file.
-/

@[simp]
lemma eq_set_tree_empty : set_tree t = {} ↔ t = nil :=
begin
  cases t with a l r,
  repeat { simp [set_tree, set.nonempty.ne_empty]},
end

@[simp]
lemma eq_empty_set_tree: {} = set_tree t ↔ t = nil :=
begin
  cases t with a l r,
  repeat { simp [ set_tree]},
  apply ne.symm,
  simp [set.nonempty.ne_empty],
end

@[simp]
lemma finite_set_tree : (set_tree t).finite :=
begin
  induction' t with a l r,
  repeat { simp [set_tree] },
  apply set.finite.union,
  { simp *,},
  assumption
end

/-
## Lemmas Subtrees
These lemmas are only in the Isabelle file.
-/

@[simp]
lemma neq_subtrees_empty : subtrees t ≠ {} :=
begin
  cases t with a l r,
  repeat { simp [subtrees, set.nonempty.ne_empty] },
end

@[simp]
lemma neg_empty_subtrees : {} ≠ subtrees t :=
begin
  apply ne.symm,
  cases t,
  repeat { simp [subtrees, set.nonempty.ne_empty] },
end

lemma size_subtrees: s ∈ subtrees t → size s <= size t :=
begin
  induction' t with a l r,
  repeat { simp [subtrees, size] },
  intro h,
  cases h,
  { cases h,
    { calc
        size s = size l + size r + 1 : by simp [*, size]
        ... ≤ size l + size r + 1: by ring},
    calc
      size s <= size l: by simp *
      ... ≤ size l + size r + 1: by linarith,},
  calc
  size s <= size r: by simp *
  ... ≤ size l + size r + 1: by linarith,
end

lemma set_treeE: a ∈ set_tree t → ∃ l r, (node a l r) ∈ subtrees t :=
begin
  induction' t fixing * with x l r,
  repeat {simp [set_tree],},
  intro h,
  cases h,
  { cases h,
    { apply exists.intro l,
      apply exists.intro r,
      rw h,
      simp [subtrees],},
    have ih_l' : ∃ (l_1 r : tree α), node a l_1 r ∈ subtrees l, from ih_l h,
    apply exists.elim ih_l',
    intros a_1 h1,
    apply exists.elim h1,
    intros a_2 h2,
    apply exists.intro a_1,
    apply exists.intro a_2,
    simp [subtrees],
    cc, },
  have ih_r': ∃ (l r_1 : tree α), node a l r_1 ∈ subtrees r, from ih_r h,
  apply exists.elim ih_r',
  intros a_1 h1,
  apply exists.elim h1,
  intros a_2 h2,
  apply exists.intro a_1,
  apply exists.intro a_2,
  simp [subtrees],
  cc,
end

@[simp]
lemma node_notin_subtrees_if : a ∉ set_tree t → node a l r ∉ subtrees t :=
begin
  induction' t fixing *,
  { simp [set_tree, subtrees] },
  simp [set_tree],
  intro h,
  rw not_or_distrib at h,
  cases h,
  rw not_or_distrib at h_left,
  have: node a l r ∉ subtrees t_1, from ih_t_1 h_right,
  have: node a l r ∉ subtrees t, from ih_t h_left.right,
  simp [subtrees],
  cc,
end

lemma in_set_tree_if: node a l r ∈ subtrees t → a ∈ set_tree t :=
begin
  contrapose,
  exact node_notin_subtrees_if a t l r
end

/-
## Lemmas List of Entries
These lemmas are only in the Isabelle file.
-/

@[simp]
lemma eq_inorder_nil: inorder t = [] ↔ t = nil :=
begin
  cases t,
  repeat { simp [inorder] },
end

@[simp]
lemma eq_nil_inorder: [] = inorder t ↔ t = nil :=
begin
  cases t,
  repeat { simp [inorder] },
end

@[simp]
lemma set_inorder : (inorder t).to_set = set_tree t :=
begin
  induction' t,
  repeat { simp only [inorder, list.to_set, set_tree] },
  simp only [set_append, list.to_set, *, set.union_empty],
end

@[simp]
lemma set_preorder : (preorder' t).to_set = set_tree t :=
begin
  induction' t,
  repeat { simp only [preorder', list.to_set, set_tree] },
  simp only [set_append, list.to_set, *, set.union_comm, set.union_empty],
end

@[simp]
lemma set_postorder : (postorder t).to_set = set_tree t :=
begin
  induction' t,
  repeat { simp  [postorder, list.to_set, set_tree] },
  simp [set_append, list.to_set, *, set.union_empty, set.insert_union],
end

@[simp]
lemma length_preorder: (preorder' t).length = size t :=
begin
  induction' t,
  repeat { simp [size, preorder', *] },
end

@[simp]
lemma length_inorder: (inorder t).length = size t :=
begin
  induction' t,
  repeat { simp [size, inorder, *, add_assoc] },
end

@[simp]
lemma length_postorder: (postorder t).length = size t :=
begin
  induction' t,
  repeat { simp [size, postorder, *, add_assoc] },
end

lemma preorder_map: preorder' (map f t) = list.map f (preorder' t) :=
begin
  induction' t,
  repeat { simp [map, preorder', *] },
end

lemma inorder_map: inorder (map f t) = list.map f (inorder t) :=
begin
  induction' t,
  repeat { simp [map, inorder, *] },
end

lemma postorder_map: postorder (map f t) = list.map f (postorder t) :=
begin
  induction' t,
  repeat { simp [map, postorder, *] },
end


/- # LoVe Exercise 2: Backward Proofs -/

set_option pp.beta true
set_option pp.generalized_field_notation false

namespace LoVe

namespace backward_proofs

/- ## Question 1: Connectives and Quantifiers
1.1. Carry out the following proofs using basic tactics.
Hint: Some strategies for carrying out such proofs are described at the end of
Section 2.3 in the Hitchhiker's Guide. -/

lemma I (a : Prop) :
  a → a :=
begin
  intro h1,
  exact h1,
end

lemma K (a b : Prop) :
  a → b → b :=
begin
  assume ha,
  exact I(b),
end

lemma C (a b c : Prop) :
  (a → b → c) → b → a → c :=
begin
  assume h1,
  assume hb,
  assume ha,
  exact h1 ha hb,
end

lemma proj_1st (a : Prop) :
  a → a → a :=
begin
  assume h1,
  assume h2,
  exact h1,
end

/- Please give a different answer than for `proj_1st`: -/

lemma proj_2nd (a : Prop) :
  a → a → a :=
begin
  exact K a a,
end

lemma some_nonsense (a b c : Prop) :
  (a → b → c) → a → (a → c) → b → c :=
begin
  assume h1,
  assume ha,
  assume hac,
  assume hb,
  exact hac ha,
end

/- 1.2. Prove the contraposition rule using basic tactics. -/

lemma contrapositive (a b : Prop) :
  (a → b) → ¬ b → ¬ a :=
begin
  assume hab,
  assume nob,
  assume ha,
  exact nob (hab ha),
end

/- 1.3. Prove the distributivity of `∀` over `∧` using basic tactics.
Hint: This exercise is tricky, especially the right-to-left direction. Some
forward reasoning, like in the proof of `and_swap₂` in the lecture, might be
necessary. -/

lemma forall_and {α : Type} (p q : α → Prop) :
  (∀x, p x ∧ q x) ↔ (∀x, p x) ∧ (∀x, q x) :=
begin
  apply iff.intro,
  {
    assume h1,
    apply and.intro,
    {
      assume t,
      have h2 := h1 t,
      exact and.elim_left h2,
    },
    {
      assume t,
      have h2 := h1 t,
      exact and.elim_right h2,
    }
  },
  {
    assume h1,
    assume t,
    exact and.intro (and.elim_left h1 t) (and.elim_right h1 t)
    }
end

/- ## Question 2: Natural Numbers
2.1. Prove the following recursive equations on the first argument of the
`mul` operator defined in lecture 1. -/

#check mul

lemma mul_zero (n : ℕ) :
  mul 0 n = 0 :=
sorry

lemma mul_succ (m n : ℕ) :
  mul (nat.succ m) n = add (mul m n) n :=
sorry

/- 2.2. Prove commutativity and associativity of multiplication using the
`induction'` tactic. Choose the induction variable carefully. -/

lemma mul_comm (m n : ℕ) :
  mul m n = mul n m :=
sorry

lemma mul_assoc (l m n : ℕ) :
  mul (mul l m) n = mul l (mul m n) :=
sorry

/- 2.3. Prove the symmetric variant of `mul_add` using `rw`. To apply
commutativity at a specific position, instantiate the rule by passing some
arguments (e.g., `mul_comm _ l`). -/

lemma add_mul (l m n : ℕ) :
  mul (add l m) n = add (mul n l) (mul n m) :=
sorry

/- ## Question 3 (**optional**): Intuitionistic Logic
Intuitionistic logic is extended to classical logic by assuming a classical
axiom. There are several possibilities for the choice of axiom. In this
question, we are concerned with the logical equivalence of three different
axioms: -/

def excluded_middle :=
∀a : Prop, a ∨ ¬ a

def peirce :=
∀a b : Prop, ((a → b) → a) → a

def double_negation :=
∀a : Prop, (¬¬ a) → a

/- For the proofs below, please avoid using lemmas from Lean's `classical`
namespace, because this would defeat the purpose of the exercise.
3.1 (**optional**). Prove the following implication using tactics.
Hint: You will need `or.elim` and `false.elim`. You can use
`rw excluded_middle` to unfold the definition of `excluded_middle`,
and similarly for `peirce`. -/

lemma peirce_of_em :
  excluded_middle → peirce :=
begin
  rw excluded_middle,
  rw peirce,
  assume exc,
  assume ha hb,
  assume h1,
  apply or.elim (exc ha),
  {
    assume a,
    exact a,
  },
  {
    assume noa,
    apply h1,
    assume a,
    apply false.elim,
    exact noa a,
  }
end

/- 3.2 (**optional**). Prove the following implication using tactics. -/

lemma dn_of_peirce :
  peirce → double_negation :=
begin
  rw peirce,
  rw double_negation,
  assume hpeir,
  assume a,
  assume hnonoa,
  apply hpeir a false,
  assume hnoa,
  apply false.elim,
  apply hnonoa,
  exact hnoa,
end

/- We leave the missing implication for the homework: -/

namespace sorry_lemmas

lemma em_of_dn :
  double_negation → excluded_middle :=
sorry

end sorry_lemmas

end backward_proofs

end LoVe


/-
Copyright (c) 2020 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin
-/
import data.polynomial.ring_division
import data.mv_polynomial.rename
import ring_theory.polynomial.basic

/-!
## Function extensionality for multivariate polynomials

In this file we show that two multivariate polynomials over an infinite integral domain are equal
if they are equal upon evaluating them on an arbitrary assignment of the variables.

# Main declaration

* `mv_polynomial.funext`: two polynomials `φ ψ : mv_polynomial σ R`
  over an infinite integral domain `R` are equal if `eval x φ = eval x ψ` for all `x : σ → R`.

-/

namespace mv_polynomial

variables {R : Type*} [comm_ring R] [is_domain R] [infinite R]

private lemma funext_fin {n : ℕ} {p : mv_polynomial (fin n) R}
  (h : ∀ x : fin n → R, eval x p = 0) : p = 0 :=
begin
  unfreezingI { induction n with n ih generalizing R },
  { let e := (mv_polynomial.is_empty_ring_equiv R (fin 0)),
    apply e.injective,
    rw ring_equiv.map_zero,
    convert h fin_zero_elim,
    suffices : (eval₂_hom (ring_hom.id _) (is_empty.elim' fin.is_empty)) p =
      (eval fin_zero_elim : mv_polynomial (fin 0) R →+* R) p,
    { rw [← this],
      simp only [coe_eval₂_hom, is_empty_ring_equiv_apply,
        ring_equiv.trans_apply, aeval_eq_eval₂_hom],
      congr },
    exact eval₂_hom_congr rfl (subsingleton.elim _ _) rfl },
  { let e := (fin_succ_equiv R n).to_ring_equiv,
    apply e.injective,
    simp only [ring_equiv.map_zero],
    apply polynomial.funext,
    intro q,
    rw [polynomial.eval_zero],
    apply ih, swap, { apply_instance },
    intro x,
    dsimp [e],
    rw [fin_succ_equiv_apply],
    calc _ = eval _ p : _
       ... = 0 : h _,
    { intro i, exact fin.cases (eval x q) x i },
    apply induction_on p,
    { intro r,
      simp only [eval_C, polynomial.eval_C, ring_hom.coe_comp, eval₂_hom_C], },
    { intros, simp only [*, ring_hom.map_add, polynomial.eval_add] },
    { intros φ i hφ, simp only [*, eval_X, polynomial.eval_mul, ring_hom.map_mul, eval₂_hom_X'],
      congr' 1,
      by_cases hi : i = 0,
      { subst hi, simp only [polynomial.eval_X, fin.cases_zero] },
      { rw [← fin.succ_pred i hi], simp only [eval_X, polynomial.eval_C, fin.cases_succ] } },
    { apply_instance, }, },
end

/-- Two multivariate polynomials over an infinite integral domain are equal
if they are equal upon evaluating them on an arbitrary assignment of the variables. -/
lemma funext {σ : Type*} {p q : mv_polynomial σ R}
  (h : ∀ x : σ → R, eval x p = eval x q) : p = q :=
begin
  suffices : ∀ p, (∀ (x : σ → R), eval x p = 0) → p = 0,
  { rw [← sub_eq_zero, this (p - q)], simp only [h, ring_hom.map_sub, forall_const, sub_self] },
  clear h p q,
  intros p h,
  obtain ⟨n, f, hf, p, rfl⟩ := exists_fin_rename p,
  suffices : p = 0, { rw [this, alg_hom.map_zero] },
  apply funext_fin,
  intro x,
  classical,
  convert h (function.extend f x 0),
  simp only [eval, eval₂_hom_rename, function.extend_comp hf]
end

lemma funext_iff {σ : Type*} {p q : mv_polynomial σ R} :
  p = q ↔ (∀ x : σ → R, eval x p = eval x q) :=
⟨by rintro rfl; simp only [forall_const, eq_self_iff_true], funext⟩

end mv_polynomial


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

import tactic -- imports all the Lean tactics

/-!

# Logic in Lean, example sheet 6 : "or" (∨`)

We learn about how to manipulate `P ∨ Q` in Lean.

## Tactics

You'll need to know about the tactics from the previous sheets,
and also the following tactics

* `left` and `right`
* `cases` (new functionality)

-/

-- Throughout this sheet, `P`, `Q`, `R` and `S` will denote propositions.

variables (P Q R S : Prop)

example : P → P ∨ Q :=
begin
  intro hP,
  left,
  exact hP,
end

example : Q → P ∨ Q :=
begin
  intro hQ,
  right,
  exact hQ,
end

example : P ∨ Q → (P → R) → (Q → R) → R :=
begin
  intros hPoQ hPR hQR,
  cases hPoQ with hP hQ,
  { apply hPR,
    exact hP },
  { exact hQR hQ }
end

-- symmetry of `or`
example : P ∨ Q → Q ∨ P :=
begin
  intro hPoQ,
  cases hPoQ with hP hQ,
  { right, assumption },
  { left, assumption }
end

-- associativity of `or`
example : (P ∨ Q) ∨ R ↔ P ∨ (Q ∨ R) :=
begin
  split,
  { rintros ((hP | hQ) | hR),
    { left, exact hP },
    { right, left, exact hQ },
    { right, right, exact hR } },
  { rintros (hP | hQ | hR),
    { left, left, exact hP },
    { left, right, exact hQ },
    { right, exact hR } }
end

example : (P → R) → (Q → S) → P ∨ Q → R ∨ S :=
begin
  rintro hPR hQS (hP | hQ),
  { left, apply hPR, exact hP },
  { right, exact hQS hQ }
end

example : (P → Q) → P ∨ R → Q ∨ R :=
begin
  intros hPQ h,
  cases h with hP hR,
  { left, apply hPQ, exact hP },
  { right, exact hR }
end

example : (P ↔ R) → (Q ↔ S) → (P ∨ Q ↔ R ∨ S) :=
begin
  intros h1 h2,
  rw [h1, h2],
end

-- de Morgan's laws
example : ¬ (P ∨ Q) ↔ ¬ P ∧ ¬ Q :=
begin
  split,
  { intro h,
    split,
    { intro hP,
      apply h,
      left,
      exact hP },
    { intro hQ,
      apply h,
      right,
      exact hQ } },
  { rintro ⟨hnP, hnQ⟩ (hP | hQ),
    { apply hnP, exact hP },
    { exact hnQ hQ } }
end

example : ¬ (P ∧ Q) ↔ ¬ P ∨ ¬ Q :=
begin
  split,
  { intro h,
    by_cases hP : P,
    { right,
      intro hQ,
      apply h,
      exact ⟨hP, hQ⟩ },
    { left,
      exact hP } },
  { rintro (hnP | hnQ) ⟨hP, hQ⟩,
    { contradiction },
    { apply hnQ, exact hQ } }
end


import set_theory_world.image_union -- hide
open function -- hide
open_locale big_operators -- hide
/-
## Indexed unions

In this level we learn how to work with arbitrary indexed unions. These are made
of an index set, and a function `A : I → set X`, that picks a subset of `A i` of `X` for
each index `i : I`.

The defining property of the union is given by the following lemma:
-/

/- Symbol :
∪ : \cup
∩ : \cap
⋃ : \Union
⋂ : \Inter
-/
variables {X Y I : Type} -- hide
variables {A : I → set X}
variable {x : X}

lemma mem_Union : (x ∈ ⋃ i, A i) ↔ ∃ i, x ∈ A i :=
set.mem_Union -- hide

/- Lemma :
The image of an arbitrary union of sets is the union of the images.
-/
lemma image_Union  (f : X → Y) (A : I → set X) :
f '' ( ⋃ i, A i ) = ⋃ i, f '' (A i) :=
begin
  ext y,
  split,
  {
    intro h,
    obtain ⟨x, ⟨hx1, hx2⟩⟩ := h,
    rw set.mem_Union at hx1,
    obtain ⟨j, hj⟩ := hx1,
    rw mem_Union,
    use j,
    use x,
    split; assumption,
  },
  {
    intro h,
    rw mem_Union at h,
    obtain ⟨i, hi⟩ := h,
    obtain ⟨x, ⟨hx1, hx2⟩⟩ := hi,
    use x,
    rw mem_Union,
    split,
    {
      use i,
      assumption,
    },
    {
      assumption,
    }
  }

end


/-
Simulating classical reasoning without assuming excluded middle.
The idea is to use the double-negation translation.
We define several "helper" theorems for double negated formulas.
-/
variables {p q r : Prop}

theorem not_and_of_or_not : ¬p ∨ ¬q → ¬(p ∧ q) :=
λ h hpq, or.elim h
  (λ hnp : ¬p, absurd (and.elim_left hpq) hnp)
  (λ hnq : ¬q, absurd (and.elim_right hpq) hnq)

theorem not_or_elim_left : ¬(p ∨ q) → ¬p :=
λ hpq hp, absurd (or.inl hp) hpq

theorem not_or_elim_right : ¬(p ∨ q) → ¬q :=
λ hpq hq, absurd (or.inr hq) hpq

theorem not_imp_elim_right : ¬(p → q) → ¬q :=
λ h₁ hq, absurd (λ h, hq) h₁

theorem not_imp_elim_left : ¬(p → q) → ¬¬p :=
λ h₁ hnp, absurd (λ hp, by contradiction) h₁

theorem not_imp_intro : ¬¬p → ¬q → ¬(p → q) :=
λ hnnp hnq hpq,
  have hnp : ¬ p, from λ hp, absurd (hpq hp) hnq,
  absurd hnp hnnp

/- Double negation introduction -/
theorem nn_intro : p → ¬¬p :=
λ hp hnp, absurd hp hnp

/- Double negated implication -/
-- Introduction
theorem nn_imp_intro : (¬¬p → ¬¬q) → ¬¬(p → q) :=
λ h hnpq,
  have hnnp : ¬¬p, from not_imp_elim_left hnpq,
  have hnq  : ¬q,  from not_imp_elim_right hnpq,
  have hnnq : ¬¬q, from h hnnp,
  absurd hnq hnnq

-- Elimination (modus ponens)
theorem nn_mp : ¬¬(p → q) → p → ¬¬q :=
λ hpq hp hnq,
  have aux : ¬(p → q), from not_imp_intro (nn_intro hp) hnq,
  absurd aux hpq

-- Double negated modus tollens
theorem nn_mt : ¬¬(p → q) → ¬q → ¬p :=
λ hpq hnq hp, absurd hnq (nn_mp hpq hp)

/- Double negated disjuction -/
lemma not_or_of_not_of_not : ¬p → ¬q → ¬(p ∨ q) :=
λ hnp hnq hpq, or.elim hpq (λ hp, absurd hp hnp) (λ hq, absurd hq hnq)

-- Elimination
theorem nn_or_elim : ¬¬(p ∨ q) → (p → ¬¬r) → (q → ¬¬r) → ¬¬r :=
λ hpq hpr hqr hnr,
  have hnp : ¬p, from λhp, absurd hnr (hpr hp),
  have hnq : ¬q, from λhq, absurd hnr (hqr hq),
  have aux : ¬(p ∨ q), from not_or_of_not_of_not hnp hnq,
  absurd aux hpq

-- Introduction
theorem nn_or_inl : ¬¬p → ¬¬(p ∨ q) :=
λ h hnpq, absurd (not_or_elim_left hnpq) h

theorem nn_or_inr : ¬¬q → ¬¬(p ∨ q) :=
λ h hnpq, absurd (not_or_elim_right hnpq) h

/- Double negated conjunction -/

-- Elimination
theorem nn_and_elim_left : ¬¬(p ∧ q) → ¬¬p :=
λ h hnp, absurd (not_and_of_or_not (or.inl hnp)) h

theorem nn_and_elim_right : ¬¬(p ∧ q) → ¬¬q :=
λ h hnq, absurd (not_and_of_or_not (or.inr hnq)) h

-- Introduction
theorem nn_and_intro : ¬¬p → ¬¬q → ¬¬(p ∧ q) :=
λ hnnp hnnq hnpq,
  have h₁ : ¬(p → ¬q), from not_imp_intro hnnp hnnq,
  have h₂ :  p → ¬q,   from λ hp hq, absurd (and.intro hp hq) hnpq,
  absurd h₂ h₁

/- Double negated excluded middle -/
theorem nn_em : ¬¬(p ∨ ¬p) :=
λ hn,
  have hnp : ¬p,   from not_or_elim_left hn,
  have hnnp : ¬¬p, from not_or_elim_right hn,
  absurd hnp hnnp

/- Examples: the following two examples are classically valid.
   We can "simulate" the classical proofs using double negation.
-/
example : ¬¬((p → q) → (¬p ∨ q)) :=
nn_imp_intro (λ h, nn_or_elim (@nn_em p)
  (λ hp  : p,
     have hnnq : ¬¬q, from nn_mp h hp,
     nn_or_inr hnnq)
  (λ hnp : ¬p, nn_intro (or.inl hnp)))

/- "Prove" Peirce's law -/
example : ¬¬(((p → q) → p) → p) :=
nn_imp_intro (λ h, nn_or_elim (@nn_em p)
  (λ hp  :  p, nn_intro hp)
  (λ hnp : ¬p,
    have h₁ : ¬(p → q), from nn_mt h hnp,
    have hnnp : ¬¬p,    from not_imp_elim_left h₁,
    absurd hnp hnnp))


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

! This file was ported from Lean 3 source module analysis.complex.arg
! leanprover-community/mathlib commit 17ef379e997badd73e5eabb4d38f11919ab3c4b3
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.InnerProductSpace.Basic
import Mathbin.Analysis.SpecialFunctions.Complex.Arg

/-!
# Rays in the complex numbers

This file links the definition `same_ray ℝ x y` with the equality of arguments of complex numbers,
the usual way this is considered.

## Main statements

* `complex.same_ray_iff` : Two complex numbers are on the same ray iff one of them is zero, or they
  have the same argument.
* `complex.abs_add_eq/complex.abs_sub_eq`: If two non zero complex numbers have different argument,
  then the triangle inequality becomes strict.

-/

variable {x y : ℂ}

namespace Complex

theorem sameRay_iff : SameRay ℝ x y ↔ x = 0 ∨ y = 0 ∨ x.arg = y.arg :=
  by
  rcases eq_or_ne x 0 with (rfl | hx)
  · simp
  rcases eq_or_ne y 0 with (rfl | hy)
  · simp
  simp only [hx, hy, false_or_iff, sameRay_iff_norm_smul_eq, arg_eq_arg_iff hx hy]
  field_simp [hx, hy]
  rw [mul_comm, eq_comm]
#align complex.same_ray_iff Complex.sameRay_iff

theorem sameRay_iff_arg_div_eq_zero : SameRay ℝ x y ↔ arg (x / y) = 0 :=
  by
  rw [← Real.Angle.toReal_zero, ← arg_coe_angle_eq_iff_eq_to_real, same_ray_iff]
  by_cases hx : x = 0; · simp [hx]
  by_cases hy : y = 0; · simp [hy]
  simp [hx, hy, arg_div_coe_angle, sub_eq_zero]
#align complex.same_ray_iff_arg_div_eq_zero Complex.sameRay_iff_arg_div_eq_zero

theorem abs_add_eq_iff : (x + y).abs = x.abs + y.abs ↔ x = 0 ∨ y = 0 ∨ x.arg = y.arg :=
  sameRay_iff_norm_add.symm.trans sameRay_iff
#align complex.abs_add_eq_iff Complex.abs_add_eq_iff

theorem abs_sub_eq_iff : (x - y).abs = |x.abs - y.abs| ↔ x = 0 ∨ y = 0 ∨ x.arg = y.arg :=
  sameRay_iff_norm_sub.symm.trans sameRay_iff
#align complex.abs_sub_eq_iff Complex.abs_sub_eq_iff

theorem sameRay_of_arg_eq (h : x.arg = y.arg) : SameRay ℝ x y :=
  sameRay_iff.mpr <| Or.inr <| Or.inr h
#align complex.same_ray_of_arg_eq Complex.sameRay_of_arg_eq

theorem abs_add_eq (h : x.arg = y.arg) : (x + y).abs = x.abs + y.abs :=
  (sameRay_of_arg_eq h).norm_add
#align complex.abs_add_eq Complex.abs_add_eq

theorem abs_sub_eq (h : x.arg = y.arg) : (x - y).abs = ‖x.abs - y.abs‖ :=
  (sameRay_of_arg_eq h).norm_sub
#align complex.abs_sub_eq Complex.abs_sub_eq

end Complex


/-
Copyright (c) 2020 Kevin Buzzard. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kevin Buzzard
-/
import algebra.group.pi
import algebra.group.commute
import data.int.basic
import tactic.linarith

/-!
# IMO 2019 Q1

Determine all functions `f : ℤ → ℤ` such that, for all integers `a` and `b`,
`f(2a) + 2f(b) = f(f(a+b))`.

The desired theorem is that either:
  -  `f = λ _, 0`
  -  `∃ c, f = λ x, 2 * x + c`

Note that there is a much more compact proof of this fact in Isabelle/HOL
  - http://downthetypehole.de/paste/4YbGgqb4
-/

theorem imo2019Q1 (f : ℤ → ℤ) :
  (∀ a b : ℤ, f (2 * a) + 2 * (f b) = f (f (a + b))) ↔
    (f = 0) ∨ ∃ c, f = λ x, 2 * x + c :=
begin
  split, swap,
  -- easy way: f(x)=0 and f(x)=2x+c work.
  { rintros (rfl|⟨c, rfl⟩); intros; simp only [pi.zero_apply]; ring },
  -- hard way.
  intro hf, -- functional equation
  -- Using `h` for `(0, b)` and `(-1, b + 1)`, we get `f (b + 1) = f b + m`
  obtain ⟨m, H⟩ : ∃ m, ∀ b, f (b + 1) = f b + m,
  { refine ⟨(f 0 - f (-2)) / 2, λ b, _⟩,
    refine sub_eq_iff_eq_add'.1 (int.eq_div_of_mul_eq_right two_ne_zero _),
    have h1 : f 0 + 2 * f b = f (f b) := by simpa using hf 0 b,
    have h2 : f (-2) + 2 * f (b + 1) = f (f b) := by simpa using hf (-1) (b + 1),
    linarith },
  -- Hence, `f` is an affine map, `f b = f 0 + m * b`
  obtain ⟨c, H⟩ : ∃ c, ∀ b, f b = c + m * b,
  { refine ⟨f 0, λ b, _⟩,
    induction b using int.induction_on with b ihb b ihb,
    { simp },
    { simp [H, ihb, mul_add, add_assoc] },
    { rw ← sub_eq_of_eq_add (H _),
      simp [ihb]; ring } },
  -- Now use `hf 0 0` and `hf 0 1` to show that `m ∈ {0, 2}`
  have H3 : 2 * c = m * c := by simpa [H, mul_add] using hf 0 0,
  obtain (rfl|rfl) : 2 = m ∨ m = 0 := by simpa [H, mul_add, H3] using hf 0 1,
  { right, use c, ext b, simp [H, add_comm] },
  { left, ext b, simpa [H, two_ne_zero] using H3 }
end


/- TACTICS -/

namespace TBA

-- definitions from last week
-- NOTE: We renamed it from `Nat'` for consistency. The new namespace makes sure we don't use the
-- standard library `Nat`.
inductive Nat : Type
  | zero : Nat
  | succ (n : Nat) : Nat

open Nat

def add (m n : Nat) : Nat :=
  match n with
  | zero   => m
  | succ n => succ (add m n)

-- With this command we add a notation for `add`. From now on we will be able to write `m + n` for
-- `add m n`. The 65 denotes how strongly the operator should bind to what's adjacent to it.
-- The `priority` means that Lean will prefer it over the built-in `+`.
infix:65 (priority := high) " + " => add

def mul (m n : Nat) : Nat :=
  match n with
  | zero   => zero
  | succ n => (mul m n) + m

-- We also want a notation for `mul`, with a higher binding strength than addition so that
-- `a + b * c` means `a + (b * c`)`.
infix:70 (priority := high) " * " => mul

inductive LE : Nat → Nat → Prop where
  | refl (n : Nat) : LE n n
  | succ : LE m n → LE m (succ n)

-- lower binding strength than either addition or multiplication
infix:50 (priority := high) " ≤ " => LE

-- Let's start by reproving some theorems from last week, but this time with tactics!
-- useful tactics:
-- * `induction ... with ...`
-- * `simp only [f]` to unfold applications of a function `f`
-- * `rw [h]` to rewrite every `a` to `b` if `h : a = b`
-- * `apply/exact`
-- * `simp/simp_all`... are powerful and basically always useful, though make sure that you could also
--   do the proof without them
theorem zero_add : zero + n = n := by
  induction n with
  | zero      =>
    rfl
    -- same as
    --exact rfl
  | succ n ih =>
    simp only [add]
    rw [ih]
    -- or
    --simp [add, ih]
  -- or simply
  --induction n <;> simp_all [add]

theorem le_add : m ≤ m + n := by
  induction n with
  | zero =>
    apply LE.refl
    -- same as
    --exact LE.refl _
  | succ n ih =>
    simp only [add]  -- optional, but helpful
    apply LE.succ
    apply ih
    -- same as
    --exact LE.succ ih
    -- alternatively, simply use
    --simp [add, LE.succ, ih]
    -- ...but using a conditional simp theorem like `LE.succ` is usually not obvious
    -- when first writing a proof
  -- or simply
  --induction n <;> simp_all [LE.refl, LE.succ, add]

-- Alright, let's start automating more!
attribute [simp] add mul
-- These definitions will now automatically be unfolded when you use `simp/simp_all`

theorem add_succ : (succ n) + m = succ (n + m) := by
  induction m <;> simp_all [zero_add]

-- This one is a bit more tricky, you might need to prove a helper lemma!
theorem add_comm : n + m = m + n := by
  induction n with
  | zero      => simp [zero_add]
  | succ n ih => simp [add_succ, ih]

-- Associativity can be proven in a similar way.
theorem add_assoc : (m + n) + k = m + (n + k) := by
  induction k with
  | zero      => rfl
  | succ k ih => simp [add_succ, ih]

def one := succ zero

theorem mul_one : m * one = m := by
  simp [zero_add]

-- To prove associativity of multiplication, you might have to come up with
-- some more lemmas about multiplication first. Some are similar to the above laws of
-- addition, some use both addition and multiplication ("distributivity" is the keyword).

theorem left_distrib : m * (n + k) = (m * n) + (m * k) := by
  induction k with
  | zero      => simp
  | succ k ih =>
    simp only [mul]
    rw [ih, ←add_assoc]
    -- NOTE: We *could* also use `add_assoc` as a simp theorem here.
    -- ```
    --  | succ n ih => simp [add_succ, ih, add_assoc]
    -- ```
    -- This even works with `add_comm` since `simp` is clever enough to avoid
    -- permutating applicable terms endlessly! However, such general simp theorems
    -- are best avoided for performance reasons and unintended interactions with
    -- other simp theorems.

theorem mul_assoc : (m * n) * k = m * (n * k) := by
  induction k with
  | zero      => rfl
  | succ k ih => simp [ih, left_distrib]

-- Remember the structures for semigroups and monoids which we defined last week?
structure Semigroup (α : Type) where
  mul   : α → α → α
  assoc : mul (mul a b) c = mul a (mul b c)

structure Monoid (α : Type) extends Semigroup α where
  e     : α
  e_mul : mul e a = a
  mul_e : mul a e = a

theorem one_mul : one * m = m := by
  induction m with
  | zero      => rfl
  | succ m ih => simp [ih]

-- You should now be able to instantiate two of them,  including proofs!
def Nat_add_Monoid : Monoid Nat :=
  { mul := add,
    assoc := add_assoc,
    e := zero,
    e_mul := by intros; simp [zero_add]
    mul_e := by intros; rfl }

def Nat_mul_Monoid : Monoid Nat :=
  { mul := mul,
    assoc := mul_assoc,
    e := one,
    e_mul := one_mul,
    mul_e := mul_one }


/- Problem 1: Append and Reverse -/

/- Prove the following theorems. If you can't complete a proof,
you can use the tactic `sorry` for any part that you are
unable to complete. -/

/- Note that we again define our own append reverse,
this time using the built in types -/

-- part p1
def app : List Nat -> List Nat -> List Nat
  | List.nil,       bs => bs
  | List.cons a as, bs => List.cons a (app as bs)

def rev : List Nat -> List Nat
  | List.nil => List.nil
  | List.cons a L => app (rev L) (List.cons a List.nil)

-- 6 lines
theorem app_nil : forall (l : List Nat), app l [] = l :=
  by sorry

-- 6 lines
theorem app_assoc : forall (l1 l2 l3 : List Nat),
  app (app l1 l2) l3 = app l1 (app l2 l3) :=
 by sorry

-- 8 lines
theorem rev_app_distr: forall l1 l2 : List Nat,
  rev (app l1 l2) = app (rev l2) (rev l1) :=
 by sorry

-- 8 lines
theorem rev_involutive : forall l : List Nat,
  rev (rev l) = l :=
 by sorry
-- part p1

/- Problem 2: Evenness (and Relations) -/

/- Prove the following theorems. If you can't complete a proof,
you can use the tactic `sorry` for any part that you are
unable to complete. -/

-- part p2
inductive ev : Nat -> Prop
| O : ev 0
| SS (n : Nat) (H : ev n) : ev (Nat.succ (Nat.succ n))

def double : Nat -> Nat
| 0 => 0
| Nat.succ n => Nat.succ (Nat.succ (double n))

-- 5 lines
theorem ev_double : forall n, ev (double n) :=
 by sorry

-- 15 lines
theorem ev_sum : forall n m, ev n -> ev m -> ev (Nat.add n m) :=
 by sorry

-- 3 lines
theorem three_not_ev : Not (ev 3) :=
 by sorry

inductive ev' : Nat -> Prop :=
  | O : ev' 0
  | SSO : ev' 2
  | sum n m (Hn : ev' n) (Hm : ev' m) : ev' (Nat.add n m)

-- 21 lines
theorem ev'_ev : forall n, ev' n <-> ev n :=
 by sorry

-- part p2

/- Problem 3: Subsequences -/

/- Prove the following theorems. If you can't complete a proof,
you can use the tactic `sorry` for any part that you are
unable to complete. -/

-- part p3
inductive subseq : List Nat -> List Nat -> Prop
| empty : subseq [] []
| include x l1 l2 (H : subseq l1 l2) : subseq (x::l1) (x::l2)
| skip x l1 l2 (H : subseq l1 l2) : subseq l1 (x::l2)

-- 6 lines
theorem subseq_refl : forall (l : List Nat),
  subseq l l :=
 by sorry

-- 5 lines
theorem subseq_empty : forall l, subseq [] l :=
 by sorry

-- 13 lines
theorem subseq_app : forall (l1 l2 l3 : List Nat),
  subseq l1 l2 ->
  subseq l1 (List.append l2 l3) :=
 by sorry
-- part p3

/- Problem 4: Insertion Sort -/

/- Prove the following theorems. If you can't complete a proof,
you can use the tactic `sorry` for any part that you are
unable to complete. -/

-- part p4
def insert : Nat -> List Nat -> List Nat
| y, [] => [y]
| y, x::xs => if Nat.ble y x
              then y :: x :: xs
              else x :: insert y xs

def isort : List Nat -> List Nat
| []      => []
| x :: xs => insert x (isort xs)

inductive All : {T : Type} -> (T -> Prop) -> List T -> Prop
| nil : All P []
| cons : forall x L, P x -> All P L -> All P (x :: L)

inductive Sorted : List Nat -> Prop
| nil : Sorted []
| cons : forall n l, Sorted l ->
                     All (Nat.le n) l ->
                     Sorted (n :: l)

theorem all_trans : forall (P : T -> Prop) (Q : T -> Prop) L,
  All P L ->
  (forall x, P x -> Q x) ->
  All Q L :=
 by intros P Q L Hall PtoQ
    induction Hall
    case nil => constructor
    case cons P x L Px HL =>
      constructor
      apply PtoQ
      assumption
      assumption

-- 23 lines
theorem insert_le : forall n x l,
  All (Nat.le n) l ->
  Nat.le n x ->
  All (Nat.le n) (insert x l) :=
 by sorry

theorem ble_inv : forall a b,
                  Nat.ble a b = false
               -> Nat.ble b a = true :=
 by intros a b H
    rw [Nat.ble_eq]
    cases (Nat.le_total b a)
    assumption
    rw [<- Nat.not_lt_eq]
    rw [<- Bool.not_eq_true] at H
    rw [Nat.ble_eq] at H
    contradiction

-- 37 lines
theorem insert_sorted : forall x l,
  Sorted l ->
  Sorted (insert x l) :=
 by sorry

-- 8 lines
theorem isort_sorted : forall l, Sorted (isort l) :=
 by sorry

inductive Permutation : {T : Type} -> List T -> List T -> Prop
| nil   : Permutation [] []
| skip  : forall (x : A) (l l' : List A),
          Permutation l l' ->
          Permutation (x :: l) (x :: l')
| swap  : forall (x y : A) (l : List A),
          Permutation (y :: x :: l) (x :: y :: l)
| trans : forall l l' l'' : List A,
          Permutation l l' ->
          Permutation l' l'' ->
          Permutation l l''

example : Permutation [true,true,false] [false,true,true] :=
 by apply Permutation.trans (l' := [true,false,true])
    . apply Permutation.skip
      apply Permutation.swap
    . apply Permutation.swap

-- 6 lines
theorem perm_refl : forall {T : Type} (l : List T),
  Permutation l l :=
 by sorry

-- 10 lines
theorem perm_length : forall {T : Type} (l1 l2 : List T),
  Permutation l1 l2 -> l1.length = l2.length :=
 by sorry

-- 12 lines
theorem perm_sym : forall {T : Type} (l1 l2 : List T),
  Permutation l1 l2 -> Permutation l2 l1 :=
 by sorry

-- 18 lines
theorem insert_perm : forall x l,
  Permutation (x :: l) (insert x l) :=
 by sorry

-- 10 lines
theorem isort_perm : forall l, Permutation l (isort l) :=
 by sorry

-- part p4


-- Pruebas de la distributiva de la intersección general sobre la intersección
-- ===========================================================================

-- ----------------------------------------------------
-- Ej. 1. Demostrar
--    (⋂ i, A i ∩ B i) = (⋂ i, A i) ∩ (⋂ i, B i)
-- ----------------------------------------------------

import data.set
import tactic

open set

variables {I U : Type}
variables {A B : I → set U}

-- 1ª demostración
example :
  (⋂ i, A i ∩ B i) = (⋂ i, A i) ∩ (⋂ i, B i) :=
begin
  ext,
  split,
  { intro h,
    rw mem_Inter at h,
    split,
    { rw mem_Inter,
      intro i,
      exact (h i).left, },
    { rw mem_Inter,
      intro i,
      exact (h i).right, }},
  { rintro ⟨h1, h2⟩,
    rw mem_Inter at *,
    intro i,
    exact ⟨h1 i, h2 i⟩, },
end

-- 2ª demostración
example :
  (⋂ i, A i ∩ B i) = (⋂ i, A i) ∩ (⋂ i, B i) :=
ext $
assume x : U,
iff.intro
( assume h : x ∈ ⋂ i, A i ∩ B i,
  have h1 : ∀ i, x ∈ A i ∩ B i,
    from mem_Inter.mp h,
  have h2 : ∀ i, x ∈ A i,
    from assume i, and.left (h1 i),
  have h3 : ∀ i, x ∈ B i,
    from assume i, and.right (h1 i),
  have h4 : x ∈ ⋂ i, A i,
    from mem_Inter.mpr h2,
  have h5 : x ∈ ⋂ i, B i,
    from mem_Inter.mpr h3,
  show x ∈ (⋂ i, A i) ∩ (⋂ i, B i),
    from and.intro h4 h5)
( assume h : x ∈ (⋂ i, A i) ∩ (⋂ i, B i),
  have h1 : ∀ i, x ∈ A i,
    from mem_Inter.mp (and.left h),
  have h2 : ∀ i, x ∈ B i,
    from mem_Inter.mp (and.right h),
  have h3 : ∀ i, x ∈ A i ∩ B i,
    from assume i, and.intro (h1 i) (h2 i),
  show x ∈ ⋂ i, A i ∩ B i,
    from mem_Inter.mpr h3)

-- 3ª demostración
example :
  (⋂ i, A i ∩ B i) = (⋂ i, A i) ∩ (⋂ i, B i) :=
-- by library_search
Inter_inter_distrib A B

-- 4ª demostración
example :
  (⋂ i, A i ∩ B i) = (⋂ i, A i) ∩ (⋂ i, B i) :=
ext (by finish)


/-
Copyright (c) 2022 Wrenna Robson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Wrenna Robson
-/
import topology.metric_space.basic

/-!
# Infimum separation

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

This file defines the extended infimum separation of a set. This is approximately dual to the
diameter of a set, but where the extended diameter of a set is the supremum of the extended distance
between elements of the set, the extended infimum separation is the infimum of the (extended)
distance between *distinct* elements in the set.

We also define the infimum separation as the cast of the extended infimum separation to the reals.
This is the infimum of the distance between distinct elements of the set when in a pseudometric
space.

All lemmas and definitions are in the `set` namespace to give access to dot notation.

## Main definitions
* `set.einfsep`: Extended infimum separation of a set.
* `set.infsep`: Infimum separation of a set (when in a pseudometric space).

!-/

variables {α β : Type*}

namespace set

section einfsep
open_locale ennreal
open function

/-- The "extended infimum separation" of a set with an edist function. -/
noncomputable def einfsep [has_edist α] (s : set α) : ℝ≥0∞ :=
⨅ (x ∈ s) (y ∈ s) (hxy : x ≠ y), edist x y

section has_edist
variables [has_edist α] {x y : α} {s t : set α}

lemma le_einfsep_iff {d} : d ≤ s.einfsep ↔ ∀ (x y ∈ s) (hxy : x ≠ y), d ≤ edist x y :=
by simp_rw [einfsep, le_infi_iff]

theorem einfsep_zero :
  s.einfsep = 0 ↔ ∀ C (hC : 0 < C), ∃ (x y ∈ s) (hxy : x ≠ y), edist x y < C :=
by simp_rw [einfsep, ← bot_eq_zero, infi_eq_bot, infi_lt_iff]

theorem einfsep_pos :
  0 < s.einfsep ↔ ∃ C (hC : 0 < C), ∀ (x y ∈ s) (hxy : x ≠ y), C ≤ edist x y :=
by { rw [pos_iff_ne_zero, ne.def, einfsep_zero], simp only [not_forall, not_exists, not_lt] }

lemma einfsep_top : s.einfsep = ∞ ↔ ∀ (x y ∈ s) (hxy : x ≠ y), edist x y = ∞ :=
by simp_rw [einfsep, infi_eq_top]

lemma einfsep_lt_top : s.einfsep < ∞ ↔ ∃ (x y ∈ s) (hxy : x ≠ y), edist x y < ∞ :=
by simp_rw [einfsep, infi_lt_iff]

lemma einfsep_ne_top : s.einfsep ≠ ∞ ↔ ∃ (x y ∈ s) (hxy : x ≠ y), edist x y ≠ ∞ :=
by simp_rw [←lt_top_iff_ne_top, einfsep_lt_top]

lemma einfsep_lt_iff {d} : s.einfsep < d ↔ ∃ (x y ∈ s) (h : x ≠ y), edist x y < d :=
by simp_rw [einfsep, infi_lt_iff]

lemma nontrivial_of_einfsep_lt_top (hs : s.einfsep < ∞) : s.nontrivial :=
by { rcases einfsep_lt_top.1 hs with ⟨_, hx, _, hy, hxy, _⟩, exact ⟨_, hx, _, hy, hxy⟩ }

lemma nontrivial_of_einfsep_ne_top (hs : s.einfsep ≠ ∞) : s.nontrivial :=
nontrivial_of_einfsep_lt_top (lt_top_iff_ne_top.mpr hs)

lemma subsingleton.einfsep (hs : s.subsingleton) : s.einfsep = ∞ :=
by { rw einfsep_top, exact λ _ hx _ hy hxy, (hxy $ hs hx hy).elim }

lemma le_einfsep_image_iff {d} {f : β → α} {s : set β} :
  d ≤ einfsep (f '' s) ↔ ∀ x y ∈ s, f x ≠ f y → d ≤ edist (f x) (f y) :=
by simp_rw [le_einfsep_iff, ball_image_iff]

lemma le_edist_of_le_einfsep {d x} (hx : x ∈ s) {y} (hy : y ∈ s) (hxy : x ≠ y)
  (hd : d ≤ s.einfsep) : d ≤ edist x y := le_einfsep_iff.1 hd x hx y hy hxy

lemma einfsep_le_edist_of_mem {x} (hx : x ∈ s) {y} (hy : y ∈ s) (hxy : x ≠ y) :
  s.einfsep ≤ edist x y := le_edist_of_le_einfsep hx hy hxy le_rfl

lemma einfsep_le_of_mem_of_edist_le {d x} (hx : x ∈ s) {y} (hy : y ∈ s) (hxy : x ≠ y)
  (hxy' : edist x y ≤ d) : s.einfsep ≤ d := le_trans (einfsep_le_edist_of_mem hx hy hxy) hxy'

lemma le_einfsep {d} (h : ∀ (x y ∈ s) (hxy : x ≠ y), d ≤ edist x y) :
  d ≤ s.einfsep := le_einfsep_iff.2 h

@[simp] lemma einfsep_empty : (∅ : set α).einfsep = ∞ := subsingleton_empty.einfsep

@[simp] lemma einfsep_singleton : ({x} : set α).einfsep = ∞ := subsingleton_singleton.einfsep

lemma einfsep_Union_mem_option {ι : Type*} (o : option ι) (s : ι → set α) :
  (⋃ i ∈ o, s i).einfsep = ⨅ i ∈ o, (s i).einfsep := by cases o; simp

lemma einfsep_anti (hst : s ⊆ t) : t.einfsep ≤ s.einfsep :=
le_einfsep $ λ x hx y hy, einfsep_le_edist_of_mem (hst hx) (hst hy)

lemma einfsep_insert_le : (insert x s).einfsep ≤ ⨅ (y ∈ s) (hxy : x ≠ y), edist x y :=
begin
  simp_rw le_infi_iff,
  refine λ _ hy hxy, einfsep_le_edist_of_mem (mem_insert _ _) (mem_insert_of_mem _ hy) hxy
end

lemma le_einfsep_pair : edist x y ⊓ edist y x ≤ ({x, y} : set α).einfsep :=
begin
  simp_rw [le_einfsep_iff, inf_le_iff, mem_insert_iff, mem_singleton_iff],
  rintros a (rfl | rfl) b (rfl | rfl) hab; finish
end

lemma einfsep_pair_le_left (hxy : x ≠ y) : ({x, y} : set α).einfsep ≤ edist x y :=
einfsep_le_edist_of_mem (mem_insert _ _) (mem_insert_of_mem _ (mem_singleton _)) hxy

lemma einfsep_pair_le_right (hxy : x ≠ y) : ({x, y} : set α).einfsep ≤ edist y x :=
by rw pair_comm; exact einfsep_pair_le_left hxy.symm

lemma einfsep_pair_eq_inf (hxy : x ≠ y) : ({x, y} : set α).einfsep = (edist x y) ⊓ (edist y x) :=
le_antisymm (le_inf (einfsep_pair_le_left hxy) (einfsep_pair_le_right hxy)) le_einfsep_pair

lemma einfsep_eq_infi : s.einfsep = ⨅ d : s.off_diag, (uncurry edist) (d : α × α) :=
begin
  refine eq_of_forall_le_iff (λ _, _),
  simp_rw [le_einfsep_iff, le_infi_iff, imp_forall_iff, set_coe.forall, subtype.coe_mk,
          mem_off_diag, prod.forall, uncurry_apply_pair, and_imp]
end

lemma einfsep_of_fintype [decidable_eq α] [fintype s] :
  s.einfsep = s.off_diag.to_finset.inf (uncurry edist) :=
begin
  refine eq_of_forall_le_iff (λ _, _),
  simp_rw [le_einfsep_iff, imp_forall_iff, finset.le_inf_iff, mem_to_finset, mem_off_diag,
          prod.forall, uncurry_apply_pair, and_imp]
end

lemma finite.einfsep (hs : s.finite) :
  s.einfsep = hs.off_diag.to_finset.inf (uncurry edist) :=
begin
  refine eq_of_forall_le_iff (λ _, _),
  simp_rw [le_einfsep_iff, imp_forall_iff, finset.le_inf_iff, finite.mem_to_finset, mem_off_diag,
          prod.forall, uncurry_apply_pair, and_imp]
end

lemma finset.coe_einfsep [decidable_eq α] {s : finset α} :
  (s : set α).einfsep = s.off_diag.inf (uncurry edist) :=
by simp_rw [einfsep_of_fintype, ← finset.coe_off_diag, finset.to_finset_coe]

lemma nontrivial.einfsep_exists_of_finite [finite s] (hs : s.nontrivial) :
  ∃ (x y ∈ s) (hxy : x ≠ y), s.einfsep = edist x y :=
begin
  classical,
  casesI nonempty_fintype s,
  simp_rw einfsep_of_fintype,
  rcases @finset.exists_mem_eq_inf _ _ _ _ (s.off_diag.to_finset) (by simpa) (uncurry edist)
    with ⟨_, hxy, hed⟩,
  simp_rw mem_to_finset at hxy,
  refine ⟨w.fst, hxy.1, w.snd, hxy.2.1, hxy.2.2, hed⟩
end

lemma finite.einfsep_exists_of_nontrivial (hsf : s.finite) (hs : s.nontrivial) :
  ∃ (x y ∈ s) (hxy : x ≠ y), s.einfsep = edist x y :=
by { letI := hsf.fintype, exact hs.einfsep_exists_of_finite }

end has_edist

section pseudo_emetric_space
variables [pseudo_emetric_space α] {x y z : α} {s t : set α}

lemma einfsep_pair (hxy : x ≠ y) : ({x, y} : set α).einfsep = edist x y :=
begin
  nth_rewrite 0 [← min_self (edist x y)],
  convert einfsep_pair_eq_inf hxy using 2,
  rw edist_comm
end

lemma einfsep_insert :
  einfsep (insert x s) = (⨅ (y ∈ s) (hxy : x ≠ y), edist x y) ⊓ (s.einfsep) :=
begin
  refine le_antisymm (le_min einfsep_insert_le (einfsep_anti (subset_insert _ _))) _,
  simp_rw [le_einfsep_iff, inf_le_iff, mem_insert_iff],
  rintros y (rfl | hy) z (rfl | hz) hyz,
  { exact false.elim (hyz rfl) },
  { exact or.inl (infi_le_of_le _ (infi₂_le hz hyz)) },
  { rw edist_comm, exact or.inl (infi_le_of_le _ (infi₂_le hy hyz.symm)) },
  { exact or.inr (einfsep_le_edist_of_mem hy hz hyz) }
end

lemma einfsep_triple (hxy : x ≠ y) (hyz : y ≠ z) (hxz : x ≠ z) :
  einfsep ({x, y, z} : set α) = edist x y ⊓ edist x z ⊓ edist y z :=
by simp_rw [einfsep_insert, infi_insert, infi_singleton, einfsep_singleton,
            inf_top_eq, cinfi_pos hxy, cinfi_pos hyz, cinfi_pos hxz]

lemma le_einfsep_pi_of_le {π : β → Type*} [fintype β] [∀ b, pseudo_emetric_space (π b)]
  {s : Π (b : β), set (π b)} {c : ℝ≥0∞} (h : ∀ b, c ≤ einfsep (s b) ) :
  c ≤ einfsep (set.pi univ s) :=
begin
  refine le_einfsep (λ x hx y hy hxy, _),
  rw mem_univ_pi at hx hy,
  rcases function.ne_iff.mp hxy with ⟨i, hi⟩,
  exact le_trans (le_einfsep_iff.1 (h i) _ (hx _) _ (hy _) hi) (edist_le_pi_edist _ _ i)
end

end pseudo_emetric_space

section pseudo_metric_space
variables [pseudo_metric_space α] {s : set α}

theorem subsingleton_of_einfsep_eq_top (hs : s.einfsep = ∞) : s.subsingleton :=
begin
  rw einfsep_top at hs,
  exact λ _ hx _ hy, of_not_not (λ hxy, edist_ne_top _ _ (hs _ hx _ hy hxy))
end

theorem einfsep_eq_top_iff : s.einfsep = ∞ ↔ s.subsingleton :=
⟨subsingleton_of_einfsep_eq_top, subsingleton.einfsep⟩

theorem nontrivial.einfsep_ne_top (hs : s.nontrivial) : s.einfsep ≠ ∞ :=
by { contrapose! hs, rw not_nontrivial_iff, exact subsingleton_of_einfsep_eq_top hs }

theorem nontrivial.einfsep_lt_top (hs : s.nontrivial) : s.einfsep < ∞ :=
by { rw lt_top_iff_ne_top, exact hs.einfsep_ne_top }

theorem einfsep_lt_top_iff : s.einfsep < ∞ ↔ s.nontrivial :=
⟨nontrivial_of_einfsep_lt_top, nontrivial.einfsep_lt_top⟩

theorem einfsep_ne_top_iff : s.einfsep ≠ ∞ ↔ s.nontrivial :=
⟨nontrivial_of_einfsep_ne_top, nontrivial.einfsep_ne_top⟩

lemma le_einfsep_of_forall_dist_le {d} (h : ∀ (x y ∈ s) (hxy : x ≠ y), d ≤ dist x y) :
  ennreal.of_real d ≤ s.einfsep :=
le_einfsep $
λ x hx y hy hxy, (edist_dist x y).symm ▸ ennreal.of_real_le_of_real (h x hx y hy hxy)

end pseudo_metric_space

section emetric_space
variables [emetric_space α] {x y z : α} {s t : set α} {C : ℝ≥0∞} {sC : set ℝ≥0∞}

lemma einfsep_pos_of_finite [finite s] : 0 < s.einfsep :=
begin
  casesI nonempty_fintype s,
  by_cases hs : s.nontrivial,
  { rcases hs.einfsep_exists_of_finite with ⟨x, hx, y, hy, hxy, hxy'⟩,
    exact hxy'.symm ▸ edist_pos.2 hxy },
  { rw not_nontrivial_iff at hs,
    exact hs.einfsep.symm ▸ with_top.zero_lt_top }
end

lemma relatively_discrete_of_finite [finite s] :
  ∃ C (hC : 0 < C), ∀ (x y ∈ s) (hxy : x ≠ y), C ≤ edist x y :=
by { rw ← einfsep_pos, exact einfsep_pos_of_finite }

lemma finite.einfsep_pos (hs : s.finite) : 0 < s.einfsep :=
by { letI := hs.fintype, exact einfsep_pos_of_finite }

lemma finite.relatively_discrete (hs : s.finite) :
  ∃ C (hC : 0 < C), ∀ (x y ∈ s) (hxy : x ≠ y), C ≤ edist x y :=
by { letI := hs.fintype, exact relatively_discrete_of_finite }

end emetric_space

end einfsep

section infsep
open_locale ennreal
open set function

/-- The "infimum separation" of a set with an edist function. -/
noncomputable def infsep [has_edist α] (s : set α) : ℝ := ennreal.to_real (s.einfsep)

section has_edist
variables [has_edist α] {x y : α} {s : set α}

lemma infsep_zero : s.infsep = 0 ↔ s.einfsep = 0 ∨ s.einfsep = ∞ :=
by rw [infsep, ennreal.to_real_eq_zero_iff]

lemma infsep_nonneg : 0 ≤ s.infsep := ennreal.to_real_nonneg

lemma infsep_pos : 0 < s.infsep ↔ 0 < s.einfsep ∧ s.einfsep < ∞ :=
by simp_rw [infsep, ennreal.to_real_pos_iff]

lemma subsingleton.infsep_zero (hs : s.subsingleton) : s.infsep = 0 :=
by { rw [infsep_zero, hs.einfsep], right, refl }

lemma nontrivial_of_infsep_pos (hs : 0 < s.infsep) : s.nontrivial :=
by { contrapose hs, rw not_nontrivial_iff at hs, exact hs.infsep_zero ▸ lt_irrefl _ }

lemma infsep_empty : (∅ : set α).infsep = 0 :=
subsingleton_empty.infsep_zero

lemma infsep_singleton : ({x} : set α).infsep = 0 :=
subsingleton_singleton.infsep_zero

lemma infsep_pair_le_to_real_inf (hxy : x ≠ y) :
  ({x, y} : set α).infsep ≤ (edist x y ⊓ edist y x).to_real :=
by simp_rw [infsep, einfsep_pair_eq_inf hxy]

end has_edist

section pseudo_emetric_space
variables [pseudo_emetric_space α] {x y : α} {s : set α}

lemma infsep_pair_eq_to_real : ({x, y} : set α).infsep = (edist x y).to_real :=
begin
  by_cases hxy : x = y,
  { rw hxy, simp only [infsep_singleton, pair_eq_singleton, edist_self, ennreal.zero_to_real] },
  { rw [infsep, einfsep_pair hxy] }
end

end pseudo_emetric_space

section pseudo_metric_space

variables [pseudo_metric_space α] {x y z: α} {s t : set α}

lemma nontrivial.le_infsep_iff {d} (hs : s.nontrivial) :
  d ≤ s.infsep ↔ ∀ (x y ∈ s) (hxy : x ≠ y), d ≤ dist x y :=
by simp_rw [infsep, ← ennreal.of_real_le_iff_le_to_real (hs.einfsep_ne_top), le_einfsep_iff,
            edist_dist, ennreal.of_real_le_of_real_iff (dist_nonneg)]

lemma nontrivial.infsep_lt_iff {d} (hs : s.nontrivial) :
  s.infsep < d ↔ ∃ (x y ∈ s) (hxy : x ≠ y), dist x y < d :=
by { rw ← not_iff_not, push_neg, exact hs.le_infsep_iff }

lemma nontrivial.le_infsep {d} (hs : s.nontrivial) (h : ∀ (x y ∈ s) (hxy : x ≠ y), d ≤ dist x y) :
  d ≤ s.infsep := hs.le_infsep_iff.2 h

lemma le_edist_of_le_infsep {d x} (hx : x ∈ s) {y} (hy : y ∈ s)
  (hxy : x ≠ y) (hd : d ≤ s.infsep) : d ≤ dist x y :=
begin
  by_cases hs : s.nontrivial,
  { exact hs.le_infsep_iff.1 hd x hx y hy hxy },
  { rw not_nontrivial_iff at hs,
    rw hs.infsep_zero at hd,
    exact le_trans hd dist_nonneg }
end

lemma infsep_le_dist_of_mem (hx : x ∈ s) (hy : y ∈ s) (hxy : x ≠ y) : s.infsep ≤ dist x y :=
le_edist_of_le_infsep hx hy hxy le_rfl

lemma infsep_le_of_mem_of_edist_le {d x} (hx : x ∈ s) {y} (hy : y ∈ s) (hxy : x ≠ y)
  (hxy' : dist x y ≤ d) : s.infsep ≤ d := le_trans (infsep_le_dist_of_mem hx hy hxy) hxy'

lemma infsep_pair : ({x, y} : set α).infsep = dist x y :=
by { rw [infsep_pair_eq_to_real, edist_dist], exact ennreal.to_real_of_real (dist_nonneg) }

lemma infsep_triple (hxy : x ≠ y) (hyz : y ≠ z) (hxz : x ≠ z) :
  ({x, y, z} : set α).infsep = dist x y ⊓ dist x z ⊓ dist y z :=
by simp only [infsep, einfsep_triple hxy hyz hxz, ennreal.to_real_inf, edist_ne_top x y,
             edist_ne_top x z, edist_ne_top y z, dist_edist, ne.def, inf_eq_top_iff,
             and_self, not_false_iff]

lemma nontrivial.infsep_anti (hs : s.nontrivial) (hst : s ⊆ t) : t.infsep ≤ s.infsep :=
ennreal.to_real_mono hs.einfsep_ne_top (einfsep_anti hst)

lemma infsep_eq_infi [decidable s.nontrivial] :
  s.infsep = if s.nontrivial then ⨅ d : s.off_diag, (uncurry dist) (d : α × α) else 0 :=
begin
  split_ifs with hs,
  { have hb : bdd_below (uncurry dist '' s.off_diag),
    { refine ⟨0, λ d h, _⟩,
      simp_rw [mem_image, prod.exists, uncurry_apply_pair] at h,
      rcases h with ⟨_, _, _, rfl⟩,
      exact dist_nonneg },
    refine eq_of_forall_le_iff (λ _, _),
    simp_rw [hs.le_infsep_iff, le_cinfi_set_iff (off_diag_nonempty.mpr hs) hb, imp_forall_iff,
            mem_off_diag, prod.forall, uncurry_apply_pair, and_imp] },
  { exact ((not_nontrivial_iff).mp hs).infsep_zero }
end

lemma nontrivial.infsep_eq_infi (hs : s.nontrivial)
  : s.infsep = ⨅ d : s.off_diag, (uncurry dist) (d : α × α) :=
by { classical, rw [infsep_eq_infi, if_pos hs] }

lemma infsep_of_fintype [decidable s.nontrivial] [decidable_eq α] [fintype s] :
  s.infsep = if hs : s.nontrivial then s.off_diag.to_finset.inf' (by simpa) (uncurry dist) else 0 :=
begin
  split_ifs with hs,
  { refine eq_of_forall_le_iff (λ _, _),
    simp_rw [hs.le_infsep_iff, imp_forall_iff, finset.le_inf'_iff, mem_to_finset, mem_off_diag,
             prod.forall, uncurry_apply_pair, and_imp] },
  { rw not_nontrivial_iff at hs, exact hs.infsep_zero }
end

lemma nontrivial.infsep_of_fintype [decidable_eq α] [fintype s] (hs : s.nontrivial) :
  s.infsep = s.off_diag.to_finset.inf' (by simpa) (uncurry dist) :=
by { classical, rw [infsep_of_fintype, dif_pos hs] }

lemma finite.infsep [decidable s.nontrivial] (hsf : s.finite) :
  s.infsep = if hs : s.nontrivial then hsf.off_diag.to_finset.inf' (by simpa) (uncurry dist)
  else 0 :=
begin
  split_ifs with hs,
  { refine eq_of_forall_le_iff (λ _, _),
    simp_rw [hs.le_infsep_iff, imp_forall_iff, finset.le_inf'_iff, finite.mem_to_finset,
            mem_off_diag, prod.forall, uncurry_apply_pair, and_imp] },
  { rw not_nontrivial_iff at hs, exact hs.infsep_zero }
end

lemma finite.infsep_of_nontrivial (hsf : s.finite) (hs : s.nontrivial) :
  s.infsep = hsf.off_diag.to_finset.inf' (by simpa) (uncurry dist) :=
  by { classical, simp_rw [hsf.infsep, dif_pos hs] }

lemma _root_.finset.coe_infsep [decidable_eq α] (s : finset α) :
  (s : set α).infsep = if hs : s.off_diag.nonempty then s.off_diag.inf' hs (uncurry dist)
                         else 0 :=
begin
  have H : (s : set α).nontrivial ↔ s.off_diag.nonempty,
  by rwa [← set.off_diag_nonempty, ← finset.coe_off_diag, finset.coe_nonempty],
  split_ifs with hs,
  { simp_rw [(H.mpr hs).infsep_of_fintype, ← finset.coe_off_diag, finset.to_finset_coe] },
  { exact ((not_nontrivial_iff).mp (H.mp.mt hs)).infsep_zero }
end

lemma _root_.finset.coe_infsep_of_off_diag_nonempty [decidable_eq α] {s : finset α}
  (hs : s.off_diag.nonempty) : (s : set α).infsep = s.off_diag.inf' hs (uncurry dist) :=
by rw [finset.coe_infsep, dif_pos hs]

lemma _root_.finset.coe_infsep_of_off_diag_empty [decidable_eq α] {s : finset α}
  (hs : s.off_diag = ∅) : (s : set α).infsep = 0 :=
by { rw ← finset.not_nonempty_iff_eq_empty at hs, rw [finset.coe_infsep, dif_neg hs] }

lemma nontrivial.infsep_exists_of_finite [finite s] (hs : s.nontrivial) :
  ∃ (x y ∈ s) (hxy : x ≠ y), s.infsep = dist x y :=
begin
  classical,
  casesI nonempty_fintype s,
  simp_rw hs.infsep_of_fintype,
  rcases @finset.exists_mem_eq_inf' _ _ _ (s.off_diag.to_finset) (by simpa) (uncurry dist)
    with ⟨_, hxy, hed⟩,
  simp_rw mem_to_finset at hxy,
  exact ⟨w.fst, hxy.1, w.snd, hxy.2.1, hxy.2.2, hed⟩
end

lemma finite.infsep_exists_of_nontrivial (hsf : s.finite) (hs : s.nontrivial) :
  ∃ (x y ∈ s) (hxy : x ≠ y), s.infsep = dist x y :=
by { letI := hsf.fintype, exact hs.infsep_exists_of_finite }

end pseudo_metric_space

section metric_space
variables [metric_space α] {s : set α}

lemma infsep_zero_iff_subsingleton_of_finite [finite s] :
  s.infsep = 0 ↔ s.subsingleton :=
begin
  rw [infsep_zero, einfsep_eq_top_iff, or_iff_right_iff_imp],
  exact λ H, (einfsep_pos_of_finite.ne' H).elim
end

lemma infsep_pos_iff_nontrivial_of_finite [finite s] :
  0 < s.infsep ↔ s.nontrivial :=
begin
  rw [infsep_pos, einfsep_lt_top_iff, and_iff_right_iff_imp],
  exact λ _, einfsep_pos_of_finite
end

lemma finite.infsep_zero_iff_subsingleton (hs : s.finite) :
  s.infsep = 0 ↔ s.subsingleton :=
by { letI := hs.fintype, exact infsep_zero_iff_subsingleton_of_finite }

lemma finite.infsep_pos_iff_nontrivial (hs : s.finite) :
  0 < s.infsep ↔ s.nontrivial :=
by { letI := hs.fintype, exact infsep_pos_iff_nontrivial_of_finite }

lemma _root_.finset.infsep_zero_iff_subsingleton (s : finset α) :
  (s : set α).infsep = 0 ↔ (s : set α).subsingleton := infsep_zero_iff_subsingleton_of_finite

lemma _root_.finset.infsep_pos_iff_nontrivial (s : finset α) :
  0 < (s : set α).infsep ↔ (s : set α).nontrivial := infsep_pos_iff_nontrivial_of_finite

end metric_space

end infsep

end set