constant f : Nat → Nat
@[simp] axiom fEq (x : Nat) (h : x ≠ 0) : f x = x

example (x : Nat) (h : x ≠ 0) : f x = x + 0 := by
  simp (discharger := trace_state; exact (fun h' => h') h)

example (x y : Nat) (h1 : x ≠ 0) (h2 : y ≠ 0) (h3 : x = y) : f x = f y + 0 := by
  simp (discharger := trace_state; assumption)
  assumption

example (x y : Nat) (h1 : x ≠ 0) (h2 : y ≠ 0) (h3 : x = y) : f x = f y + 0 := by
  simp (discharger := assumption)
  assumption

example (x y : Nat) (h1 : x ≠ 0) (h2 : y ≠ 0) (h3 : x = y) : f x = f y + 0 := by
  simp (disch := assumption)
  assumption

example (x y : Nat) (h1 : x ≠ 0) (h2 : y ≠ 0) (h3 : x = y) : f x = f y + 0 := by
  conv => lhs; simp (disch := assumption)
  trace_state
  conv => rhs; simp (disch := assumption)
  trace_state
  assumption


import topology.basic
import data.real.basic
import topology.metric_space.basic
import topology.uniform_space.uniform_convergence
import topology.uniform_space.basic

-- set_option pp.all true

open filter

theorem unif_cont
  (F : ℕ → ℝ → ℝ) (hF : ∀ n, continuous (F n))
  (f : ℝ → ℝ) (hFf : tendsto_uniformly F f at_top) :
  continuous f :=
begin
  -- set up fully "peeled" proof state:
  rw metric.continuous_iff,    -- metric def of continuity
  intros x ε hε,    -- introduce universally quantified variables into the proof state

  -- solution to disallowed metavarible dependencies: skolimize and rcases first!
  simp [metric.continuous_iff] at hF,    -- metric definition of continuity
  simp [classical.skolem] at hF,
  -- sometimes with skolem behind other universal quantifiers, you need to help Lean a bit
  -- (simp and rw don't work)
  -- rw [classical.skolem] at hF,    -- try yourself
  -- simp [classical.skolem] at hF,  -- try yourself
  have hF := λ n b, classical.skolem.mp (hF n b),
  have hF' := λ n, classical.skolem.mp (hF n),
  simp [classical.skolem] at hF',
  clear hF,
  clear hF,
  rcases hF' with ⟨δ, hF⟩,
  have hδ := λ n x ε hε, and.elim_left (hF n x ε hε),
  have hF := λ n x ε hε, and.elim_right (hF n x ε hε),

  -- the same for the other hypothesis
  rw metric.tendsto_uniformly_iff at hFf,
  simp at hFf,    -- get rid of `at_top`
  simp [classical.skolem] at hFf,
  rcases hFf with ⟨M, hM⟩,

  apply exists.intro,    -- delay choice, creates mvars
  apply exists.intro,    -- delay choice, creates mvars
  rotate 1,    -- postpone a goal by rotating the goal list
  intros y hxy,

  -- start the proof
  apply lt_of_le_of_lt,    -- transitivity
  apply dist_triangle,     -- triangle inequality
  rotate 1,
  apply lt_of_lt_of_le,
  apply add_lt_add_left,    -- bound a summand
  rw dist_comm,    -- symmetry
  apply hM,    -- apply the hypothesis

  rotate 4,
  apply le_trans,
  apply add_le_of_add_le_right,
  rotate 1,
  apply dist_triangle,
  rotate 9,
  -- apply le_trans,
  apply add_le_of_add_le_right,
  rotate 1,
  apply add_le_of_add_le_right,
  rotate 1,
  apply le_of_lt,
  apply hM,
  rotate 14,
  apply add_le_of_add_le_left,
  rotate 1,
  have hF' := hF _,    -- apply the hypothesis to an argument to be specified later
  apply le_of_lt,
  apply hF',

  -- supply all the epsilons
  rotate 2,
  use ε / 3,
  apply le_refl,
  rotate 1,
  use ε / 3,
  rotate 2,
  rotate 1,
  -- use ε,
  use δ (M (ε / 3) (by linarith)) x (ε / 3) (by linarith),  -- now we can supply "the" delta belonging to "the" M
  rotate 1,
  apply le_refl,
  apply le_of_eq,
  apply add_eq_of_eq_sub,
  refl,
  apply le_of_eq,
  apply eq_sub_of_add_eq,
  ring_nf,
  exact hxy,
  apply le_refl,
  apply hδ,
end

-- Toy example for this sort of behavior:
-- if we defer the choice of `y` at the very beginning,
-- the goal cannot be closed with `hx`
-- because it would assign `x` to the second goal which (syntactically) is not allowed.
-- But above we **need** to delay the choice of `δ` early so that we can continue to unpack and work with the goal.
theorem test (h : ∃ x, x = 0) : ∃ y, y = 0 :=
begin
  -- apply exists.intro,    -- uncomment
  rcases h with ⟨x, hx⟩,
  apply exists.intro,    -- comment
  exact hx,
end


/-
Copyright (c) 2014 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Leonardo de Moura, Jeremy Avigad, Haitao Zhang
-/
prelude
import init.data.prod init.funext init.logic
/-!
# General operations on functions
-/
universes u₁ u₂ u₃ u₄

namespace function
variables {α : Sort u₁} {β : Sort u₂} {φ : Sort u₃} {δ : Sort u₄} {ζ : Sort u₁}

/-- Composition of functions: `(f ∘ g) x = f (g x)`. -/
@[inline, reducible] def comp (f : β → φ) (g : α → β) : α → φ :=
λ x, f (g x)

/-- Composition of dependent functions: `(f ∘' g) x = f (g x)`, where type of `g x` depends on `x`
and type of `f (g x)` depends on `x` and `g x`. -/
@[inline, reducible] def dcomp {β : α → Sort u₂} {φ : Π {x : α}, β x → Sort u₃}
  (f : Π {x : α} (y : β x), φ y) (g : Π x, β x) : Π x, φ (g x) :=
λ x, f (g x)

infixr ` ∘ `:90  := function.comp
infixr ` ∘' `:80 := function.dcomp

@[reducible] def comp_right (f : β → β → β) (g : α → β) : β → α → β :=
λ b a, f b (g a)

@[reducible] def comp_left (f : β → β → β) (g : α → β) : α → β → β :=
λ a b, f (g a) b

/-- Given functions `f : β → β → φ` and `g : α → β`, produce a function `α → α → φ` that evaluates
`g` on each argument, then applies `f` to the results. Can be used, e.g., to transfer a relation
from `β` to `α`. -/
@[reducible] def on_fun (f : β → β → φ) (g : α → β) : α → α → φ :=
λ x y, f (g x) (g y)

@[reducible] def combine (f : α → β → φ) (op : φ → δ → ζ) (g : α → β → δ)
  : α → β → ζ :=
λ x y, op (f x y) (g x y)

/-- Constant `λ _, a`. -/
@[reducible] def const (β : Sort u₂) (a : α) : β → α :=
λ x, a

@[reducible] def swap {φ : α → β → Sort u₃} (f : Π x y, φ x y) : Π y x, φ x y :=
λ y x, f x y

@[reducible] def app {β : α → Sort u₂} (f : Π x, β x) (x : α) : β x :=
f x

infixl  ` on `:2         := on_fun
notation f ` -[` op `]- ` g  := combine f op g

lemma left_id (f : α → β) : id ∘ f = f := rfl

lemma right_id (f : α → β) : f ∘ id = f := rfl

@[simp] lemma comp_app (f : β → φ) (g : α → β) (a : α) : (f ∘ g) a = f (g a) := rfl

lemma comp.assoc (f : φ → δ) (g : β → φ) (h : α → β) : (f ∘ g) ∘ h = f ∘ (g ∘ h) := rfl

@[simp] lemma comp.left_id (f : α → β) : id ∘ f = f := rfl

@[simp] lemma comp.right_id (f : α → β) : f ∘ id = f := rfl

lemma comp_const_right (f : β → φ) (b : β) : f ∘ (const α b) = const α (f b) := rfl

/-- A function `f : α → β` is called injective if `f x = f y` implies `x = y`. -/
def injective (f : α → β) : Prop := ∀ ⦃a₁ a₂⦄, f a₁ = f a₂ → a₁ = a₂

lemma injective.comp {g : β → φ} {f : α → β} (hg : injective g) (hf : injective f) :
  injective (g ∘ f) :=
assume a₁ a₂, assume h, hf (hg h)

/-- A function `f : α → β` is called surjective if every `b : β` is equal to `f a`
for some `a : α`. -/
@[reducible] def surjective (f : α → β) : Prop := ∀ b, ∃ a, f a = b

lemma surjective.comp {g : β → φ} {f : α → β} (hg : surjective g) (hf : surjective f) :
  surjective (g ∘ f) :=
λ (c : φ), exists.elim (hg c) (λ b hb, exists.elim (hf b) (λ a ha,
  exists.intro a (show g (f a) = c, from (eq.trans (congr_arg g ha) hb))))

/-- A function is called bijective if it is both injective and surjective. -/
def bijective (f : α → β) := injective f ∧ surjective f

lemma bijective.comp {g : β → φ} {f : α → β} : bijective g → bijective f → bijective (g ∘ f)
| ⟨h_ginj, h_gsurj⟩ ⟨h_finj, h_fsurj⟩ := ⟨h_ginj.comp h_finj, h_gsurj.comp h_fsurj⟩

/-- `left_inverse g f` means that g is a left inverse to f. That is, `g ∘ f = id`. -/
def left_inverse (g : β → α) (f : α → β) : Prop := ∀ x, g (f x) = x

/-- `has_left_inverse f` means that `f` has an unspecified left inverse. -/
def has_left_inverse (f : α → β) : Prop := ∃ finv : β → α, left_inverse finv f

/-- `right_inverse g f` means that g is a right inverse to f. That is, `f ∘ g = id`. -/
def right_inverse (g : β → α) (f : α → β) : Prop := left_inverse f g

/-- `has_right_inverse f` means that `f` has an unspecified right inverse. -/
def has_right_inverse (f : α → β) : Prop := ∃ finv : β → α, right_inverse finv f

lemma left_inverse.injective {g : β → α} {f : α → β} : left_inverse g f → injective f :=
assume h a b faeqfb,
calc a = g (f a) : (h a).symm
... = g (f b) : congr_arg g faeqfb
... = b : h b

lemma has_left_inverse.injective {f : α → β} : has_left_inverse f → injective f :=
assume h, exists.elim h (λ finv inv, inv.injective)

lemma right_inverse_of_injective_of_left_inverse {f : α → β} {g : β → α}
    (injf : injective f) (lfg : left_inverse f g) :
  right_inverse f g :=
assume x,
have h : f (g (f x)) = f x, from lfg (f x),
injf h

lemma has_right_inverse.surjective {f : α → β} : has_right_inverse f → surjective f
| ⟨finv, inv⟩ := inv.surjective

lemma left_inverse_of_surjective_of_right_inverse {f : α → β} {g : β → α}
    (surjf : surjective f) (rfg : right_inverse f g) :
  left_inverse f g :=
assume y, exists.elim (surjf y) (λ x hx, calc
  f (g y) = f (g (f x)) : hx ▸ rfl
      ... = f x         : eq.symm (rfg x) ▸ rfl
      ... = y           : hx)

lemma injective_id : injective (@id α) := assume a₁ a₂ h, h

lemma surjective_id : surjective (@id α) := assume a, ⟨a, rfl⟩

lemma bijective_id : bijective (@id α) := ⟨injective_id, surjective_id⟩

end function

namespace function
variables {α : Type u₁} {β : Type u₂} {φ : Type u₃}

/-- Interpret a function on `α × β` as a function with two arguments. -/
@[inline] def curry : (α × β → φ) → α → β → φ :=
λ f a b, f (a, b)

/-- Interpret a function with two arguments as a function on `α × β` -/
@[inline] def uncurry : (α → β → φ) → α × β → φ :=
λ f a, f a.1 a.2

@[simp] lemma curry_uncurry (f : α → β → φ) : curry (uncurry f) = f :=
rfl

@[simp] lemma uncurry_curry (f : α × β → φ) : uncurry (curry f) = f :=
funext (λ ⟨a, b⟩, rfl)

protected lemma left_inverse.id {g : β → α} {f : α → β} (h : left_inverse g f) : g ∘ f = id :=
funext h

protected lemma right_inverse.id {g : β → α} {f : α → β} (h : right_inverse g f) : f ∘ g = id :=
funext h

end function


/-
Copyright (c) 2022 Yaël Dillies, Junyan Xu. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies, Junyan Xu

! This file was ported from Lean 3 source module order.extension.well
! leanprover-community/mathlib commit 23aa88e32dcc9d2a24cca7bc23268567ed4cd7d6
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Prod.Lex
import Mathbin.SetTheory.Ordinal.Arithmetic

/-!
# Extend a well-founded order to a well-order

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

This file constructs a well-order (linear well-founded order) which is an extension of a given
well-founded order.

## Proof idea

We can map our order into two well-orders:
* the first map respects the order but isn't necessarily injective. Namely, this is the *rank*
  function `rank : α → ordinal`.
* the second map is injective but doesn't necessarily respect the order. This is an arbitrary
  well-order on `α`.

Then their lexicographic product is a well-founded linear order which our original order injects in.
-/

universe u

variable {α : Type u} {r : α → α → Prop}

namespace WellFounded

variable (hwf : WellFounded r)

include hwf

#print WellFounded.wellOrderExtension /-
/-- An arbitrary well order on `α` that extends `r`.

The construction maps `r` into two well-orders: the first map is `well_founded.rank`, which is not
necessarily injective but respects the order `r`; the other map is the identity (with an arbitrarily
chosen well-order on `α`), which is injective but doesn't respect `r`.

By taking the lexicographic product of the two, we get both properties, so we can pull it back and
get an well-order that extend our original order `r`. Another way to view this is that we choose an
arbitrary well-order to serve as a tiebreak between two elements of same rank.
-/
noncomputable def wellOrderExtension : LinearOrder α :=
  let l : LinearOrder α := IsWellOrder.linearOrder WellOrderingRel
  @LinearOrder.lift' α (Ordinal ×ₗ α) _ (fun a : α => (WellFounded.rank.{u} hwf a, a)) fun _ _ =>
    congr_arg Prod.snd
#align well_founded.well_order_extension WellFounded.wellOrderExtension
-/

/- warning: well_founded.well_order_extension.is_well_founded_lt -> WellFounded.wellOrderExtension.isWellFounded_lt is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {r : α -> α -> Prop} (hwf : WellFounded.{succ u1} α r), IsWellFounded.{u1} α (LinearOrder.Lt.{u1} α (WellFounded.wellOrderExtension.{u1} α r hwf))
but is expected to have type
  forall {α : Type.{u1}} {r : α -> α -> Prop} (hwf : WellFounded.{succ u1} α r), IsWellFounded.{u1} α (LT.lt.{u1} α (Preorder.toLT.{u1} α (PartialOrder.toPreorder.{u1} α (LinearOrder.toPartialOrder.{u1} α (WellFounded.wellOrderExtension.{u1} α r hwf)))))
Case conversion may be inaccurate. Consider using '#align well_founded.well_order_extension.is_well_founded_lt WellFounded.wellOrderExtension.isWellFounded_ltₓ'. -/
instance wellOrderExtension.isWellFounded_lt : IsWellFounded α hwf.wellOrderExtension.lt :=
  ⟨InvImage.wf _ <| WellFounded.prod_lex Ordinal.wellFoundedLT.wf WellOrderingRel.isWellOrder.wf⟩
#align well_founded.well_order_extension.is_well_founded_lt WellFounded.wellOrderExtension.isWellFounded_lt

#print WellFounded.exists_well_order_ge /-
/-- Any well-founded relation can be extended to a well-ordering on that type. -/
theorem exists_well_order_ge : ∃ s, r ≤ s ∧ IsWellOrder α s :=
  ⟨hwf.wellOrderExtension.lt, fun a b h => Prod.Lex.left _ _ (hwf.rank_lt_of_rel h), by constructor⟩
#align well_founded.exists_well_order_ge WellFounded.exists_well_order_ge
-/

end WellFounded

#print WellOrderExtension /-
/-- A type alias for `α`, intended to extend a well-founded order on `α` to a well-order. -/
def WellOrderExtension (α) : Type _ :=
  α
#align well_order_extension WellOrderExtension
-/

instance [Inhabited α] : Inhabited (WellOrderExtension α) :=
  ‹Inhabited (WellOrderExtension α)›

#print toWellOrderExtension /-
/-- "Identity" equivalence between a well-founded order and its well-order extension. -/
def toWellOrderExtension : α ≃ WellOrderExtension α :=
  Equiv.refl _
#align to_well_order_extension toWellOrderExtension
-/

noncomputable instance [LT α] [WellFoundedLT α] : LinearOrder (WellOrderExtension α) :=
  (IsWellFounded.wf : @WellFounded α (· < ·)).wellOrderExtension

#print WellOrderExtension.wellFoundedLT /-
instance WellOrderExtension.wellFoundedLT [LT α] [WellFoundedLT α] :
    WellFoundedLT (WellOrderExtension α) :=
  WellFounded.wellOrderExtension.isWellFounded_lt _
#align well_order_extension.well_founded_lt WellOrderExtension.wellFoundedLT
-/

#print toWellOrderExtension_strictMono /-
theorem toWellOrderExtension_strictMono [Preorder α] [WellFoundedLT α] :
    StrictMono (toWellOrderExtension : α → WellOrderExtension α) := fun a b h =>
  Prod.Lex.left _ _ <| WellFounded.rank_lt_of_rel _ h
#align to_well_order_extension_strict_mono toWellOrderExtension_strictMono
-/


import tactic

/-
When writing proofs it's easier to write them in tactic mode.
The show_term command will show you the term mode proof for this tactic proof.
If the term mode proof is shorter, this is how the proof would be written in mathlib.
-/

-- Let P and Q be propositions.
variables P Q : Prop

-- The following is a simple proof that if we have P ∧ Q, then we also have Q ∧ P
example : P ∧ Q → Q ∧ P :=
begin
  intro h,
  split,
  exact h.right,
  exact h.left,
end

-- to write this in term_mode, use the show_term command like this

example : P ∧ Q → Q ∧ P :=
begin
  show_term {
    intro h,
    split,
    exact h.right,
    exact h.left,
  },
end

-- Clicking the show_term word above and then clicking the try this command in the infoview window will reduce this to

example : P ∧ Q → Q ∧ P :=
begin
  exact λ (h : P ∧ Q), ⟨h.right, h.left⟩,
end

-- Finally we can remove the begin exact and end parts to reduce this to
example : P ∧ Q → Q ∧ P := λ (h : P ∧ Q), ⟨h.right, h.left⟩


/-
Copyright (c) 2018 Simon Hudon. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Simon Hudon
-/
import data.dlist
import tactic.core

namespace tactic
open expr list

meta def match_fn (fn : expr) : expr → tactic (expr × expr)
| (app (app fn' e₀) e₁) := unify fn fn' $> (e₀, e₁)
| _ := failed

meta def fill_args : expr → tactic (expr × list expr)
| (pi n bi d b) :=
do v ← mk_meta_var d,
   (r, vs) ← fill_args (b.instantiate_var v),
   return (r, v::vs)
| e := return (e, [])

meta def mk_assoc_pattern' (fn : expr) : expr → tactic (dlist expr)
| e :=
  (do (e₀, e₁) ← match_fn fn e,
      (++) <$> mk_assoc_pattern' e₀ <*> mk_assoc_pattern' e₁) <|>
  pure (dlist.singleton e)

meta def mk_assoc_pattern (fn e : expr) : tactic (list expr) :=
dlist.to_list <$> mk_assoc_pattern' fn e

meta def mk_assoc (fn : expr) : list expr → tactic expr
| [] := failed
| [x] := pure x
| (x₀ :: x₁ :: xs) := mk_assoc (fn x₀ x₁ :: xs)

meta def chain_eq_trans : list expr → tactic expr
| [] := to_expr ``(rfl)
| [e] := pure e
| (e :: es) := chain_eq_trans es >>= mk_eq_trans e

meta def unify_prefix : list expr → list expr → tactic unit
| [] _ := pure ()
| _ [] := failed
| (x :: xs) (y :: ys) :=
unify x y >> unify_prefix xs ys

meta def match_assoc_pattern' (p : list expr) : list expr → tactic (list expr × list expr) | es :=
unify_prefix p es $> ([], es.drop p.length) <|>
  match es with
  | [] := failed
  | (x :: xs) := prod.map (cons x) id <$> match_assoc_pattern' xs
  end

meta def match_assoc_pattern (fn p e : expr) : tactic (list expr × list expr) :=
do p' ← mk_assoc_pattern fn p,
   e' ← mk_assoc_pattern fn e,
   match_assoc_pattern' p' e'

/-- Tag for proofs generated by `assoc_rewrite`. -/
def id_tag.assoc_proof := ()

meta def mk_eq_proof (fn : expr) (e₀ e₁ : list expr) (p : expr) : tactic (expr × expr × expr) :=
do (l, r) ← infer_type p >>= match_eq,
   if e₀.empty ∧ e₁.empty then pure (l, r, p)
   else do
     l' ← mk_assoc fn (e₀ ++ [l] ++ e₁),
     r' ← mk_assoc fn (e₀ ++ [r] ++ e₁),
     t  ← infer_type l',
     v  ← mk_local_def `x t,
     e  ← mk_assoc fn (e₀ ++ [v] ++ e₁),
     p  ← mk_congr_arg (e.lambdas [v]) p,
     p' ← mk_app ``eq [l', r'],
     let p' := mk_tagged_proof p' p ``id_tag.assoc_proof,
     return (l', r', p')

meta def assoc_root (fn assoc : expr) : expr → tactic (expr × expr) | e :=
(do (e₀, e₁) ← match_fn fn e,
    (ea, eb) ← match_fn fn e₁,
    let e' := fn (fn e₀ ea) eb,
    p' ← mk_eq_symm (assoc e₀ ea eb),
    (e'', p'') ← assoc_root e',
    prod.mk e'' <$> mk_eq_trans p' p'') <|>
prod.mk e <$> mk_eq_refl e

meta def assoc_refl' (fn assoc : expr) : expr → expr → tactic expr
| l r := (is_def_eq l r >> mk_eq_refl l) <|> do
  (l', l_p)  ← assoc_root fn assoc l <|> fail "A",
  (el₀, el₁) ← match_fn   fn l' <|> fail "B",
  (r', r_p)  ← assoc_root fn assoc r <|> fail "C",
  (er₀, er₁) ← match_fn   fn r' <|> fail "D",
  p₀ ← assoc_refl' el₀ er₀,
  p₁ ← is_def_eq el₁ er₁ >> mk_eq_refl el₁,
  f_eq ← mk_congr_arg fn p₀ <|> fail "G",
  p' ← mk_congr f_eq p₁ <|> fail "H",
  r_p' ← mk_eq_symm r_p,
  chain_eq_trans [l_p, p', r_p']

meta def assoc_refl (fn : expr) : tactic unit :=
do (l, r) ← target >>= match_eq,
   assoc ← mk_mapp ``is_associative.assoc [none, fn, none]
     <|> fail format!"{fn} is not associative",
   assoc_refl' fn assoc l r >>= tactic.exact

meta def flatten (fn assoc e : expr) : tactic (expr × expr) :=
do ls ← mk_assoc_pattern fn e,
   e' ← mk_assoc fn ls,
   p  ← assoc_refl' fn assoc e e',
   return (e', p)

meta def assoc_rewrite_intl (assoc h e : expr) : tactic (expr × expr) :=
do t ← infer_type h,
   (lhs, rhs) ← match_eq t,
   let fn  := lhs.app_fn.app_fn,
   (l, r) ← match_assoc_pattern fn lhs e,
   (lhs', rhs', h') ← mk_eq_proof fn l r h,
   e_p ← assoc_refl' fn assoc e lhs',
   (rhs'', rhs_p) ← flatten fn assoc rhs',
   final_p ← chain_eq_trans [e_p, h', rhs_p],
   return (rhs'', final_p)

-- TODO(Simon): visit expressions built of `fn` nested inside other such expressions:
-- e.g.: x + f (a + b + c) + y should generate two rewrite candidates
meta def enum_assoc_subexpr' (fn : expr) : expr → tactic (dlist expr)
| e :=
  dlist.singleton e <$ (match_fn fn e >> guard (¬ e.has_var)) <|>
  expr.mfoldl (λ es e', (++ es) <$> enum_assoc_subexpr' e') dlist.empty e

meta def enum_assoc_subexpr (fn e : expr) : tactic (list expr) :=
dlist.to_list <$> enum_assoc_subexpr' fn e

meta def mk_assoc_instance (fn : expr) : tactic expr :=
do t ← mk_mapp ``is_associative [none, fn],
   inst ← prod.snd <$> solve_aux t assumption <|>
     (mk_instance t >>= assertv `_inst t) <|>
     fail format!"{fn} is not associative",
   mk_mapp ``is_associative.assoc [none, fn, inst]

meta def assoc_rewrite (h e : expr) (opt_assoc : option expr := none) :
  tactic (expr × expr × list expr) :=
do (t, vs) ← infer_type h >>= fill_args,
   (lhs, rhs) ← match_eq t,
   let fn := lhs.app_fn.app_fn,
   es ← enum_assoc_subexpr fn e,
   assoc ← match opt_assoc with
           | none := mk_assoc_instance fn
           | (some assoc) := pure assoc
           end,
   (_, p) ← mfirst (assoc_rewrite_intl assoc $ h.mk_app vs) es,
   (e', p', _) ← tactic.rewrite p e,
   pure (e', p', vs)

meta def assoc_rewrite_target (h : expr) (opt_assoc : option expr :=  none) :
  tactic unit :=
do tgt ← target,
   (tgt', p, _) ← assoc_rewrite h tgt opt_assoc,
   replace_target tgt' p

meta def assoc_rewrite_hyp (h hyp : expr) (opt_assoc : option expr := none) :
  tactic expr :=
do tgt ← infer_type hyp,
   (tgt', p, _) ← assoc_rewrite h tgt opt_assoc,
   replace_hyp hyp tgt' p

namespace interactive

setup_tactic_parser

private meta def assoc_rw_goal (rs : list rw_rule) : tactic unit :=
rs.mmap' $ λ r, do
 save_info r.pos,
 eq_lemmas ← get_rule_eqn_lemmas r,
 orelse'
   (do e ← to_expr' r.rule, assoc_rewrite_target e)
   (eq_lemmas.mfirst $ λ n, do e ← mk_const n, assoc_rewrite_target e)
   (eq_lemmas.empty)

private meta def uses_hyp (e : expr) (h : expr) : bool :=
e.fold ff $ λ t _ r, r || (t = h)

private meta def assoc_rw_hyp : list rw_rule → expr → tactic unit
| []      hyp := skip
| (r::rs) hyp := do
  save_info r.pos,
  eq_lemmas ← get_rule_eqn_lemmas r,
  orelse'
    (do e ← to_expr' r.rule, when (¬ uses_hyp e hyp) $ assoc_rewrite_hyp e hyp >>= assoc_rw_hyp rs)
    (eq_lemmas.mfirst $ λ n, do e ← mk_const n, assoc_rewrite_hyp e hyp >>= assoc_rw_hyp rs)
    (eq_lemmas.empty)

private meta def assoc_rw_core (rs : parse rw_rules) (loca : parse location) : tactic unit :=
match loca with
| loc.wildcard := loca.try_apply (assoc_rw_hyp rs.rules) (assoc_rw_goal rs.rules)
| _            := loca.apply (assoc_rw_hyp rs.rules) (assoc_rw_goal rs.rules)
end >> try reflexivity
    >> try (returnopt rs.end_pos >>= save_info)

/--
`assoc_rewrite [h₀,← h₁] at ⊢ h₂` behaves like `rewrite [h₀,← h₁] at ⊢ h₂`
with the exception that associativity is used implicitly to make rewriting
possible.

It works for any function `f` for which an `is_associative f` instance can be found.

```
example {α : Type*} (f : α → α → α) [is_associative α f] (a b c d x : α) :
  let infix ` ~ ` := f in
  b ~ c = x → (a ~ b ~ c ~ d) = (a ~ x ~ d) :=
begin
  intro h,
  assoc_rw h,
end
```
-/
meta def assoc_rewrite (q : parse rw_rules) (l : parse location) : tactic unit :=
propagate_tags (assoc_rw_core q l)

/-- synonym for `assoc_rewrite` -/
meta def assoc_rw (q : parse rw_rules) (l : parse location) : tactic unit :=
assoc_rewrite q l

add_tactic_doc
{ name                     := "assoc_rewrite",
  category                 := doc_category.tactic,
  decl_names               := [`tactic.interactive.assoc_rewrite, `tactic.interactive.assoc_rw],
  tags                     := ["rewriting"],
  inherit_description_from := `tactic.interactive.assoc_rewrite }

end interactive
end tactic


import logic.equiv.basic
import tactic.norm_swap

open equiv tactic

/--
To properly test that norm_swap works without the help of the simplifier,
we turn off the simp lemmas that simplify swaps of the form
`swap x y x = y` and `swap x y y = x`.
-/
local attribute [-simp] swap_apply_left
local attribute [-simp] swap_apply_right

/--
We can check all possibilities of swapping of `0, 1, bit0 _, bit1 _` using the
64 combinations of `[0, 1, 2, 3]`. This example should execute and complete without error,
if `norm_swap.eval` is behaving properly.
-/
example : true := by do
  let l : list ℕ := [0, 1, 2, 3],
  let l' : list ((ℕ × ℕ) × ℕ) := (do a ← l, b ← l, c ← l, pure ((a, b), c)),
  (lhs : list expr) ← mmap (λ (tup : (ℕ × ℕ) × ℕ),
    to_expr ``(equiv.swap %%tup.fst.fst %%tup.fst.snd %%tup.snd)) l',
  (rhs : list expr) ← mmap (λ (tup : (ℕ × ℕ) × ℕ),
    if tup.snd = tup.fst.fst then to_expr ``(%%tup.fst.snd)
    else if tup.snd = tup.fst.snd then to_expr ``(%%tup.fst.fst)
    else to_expr ``(%%tup.snd)) l',
  let eqs : list expr := list.zip_with (λ L R, `(@eq.{1} ℕ %%L %%R)) lhs rhs,
  g ← get_goals,
  gls ← mmap mk_meta_var eqs,
  set_goals $ g ++ gls,
  triv, -- to discharge the starting `true` goal
  repeat $ tactic.norm_num norm_swap.eval [] (interactive.loc.ns [none]),
  done

example : true := by do
  let l : list ℤ := [0, 2, -1, 3, -4],
  let l' := (do a ← l, b ← l, c ← l, pure ((a, b), c)),
  ic ← mk_instance_cache `(ℤ),
  -- we have to convert the provided `int`s into numeral form for the goals
  -- to look like what they would usually: `⇑(swap -1 3) -4 = -4`, instead of
-- `⇑(swap (int.neg_succ_of_nat 0) (int.of_nat 3)) (int.neg_succ_of_nat 3) = int.neg_succ_of_nat 3`
  el ← mmap (λ (tup : (ℤ × ℤ) × ℤ), do
    (_, a) ← ic.of_int tup.fst.fst,
    (_, b) ← ic.of_int tup.fst.snd,
    (_, c) ← ic.of_int tup.snd,
    pure ((a, b), c)) l',
  (lhs : list expr) ← mmap (λ (tup : (expr × expr) × expr),
    to_expr ``((equiv.swap %%tup.fst.fst %%tup.fst.snd) %%tup.snd)) el,
  let rhs : list expr := el.map (λ (tup : (expr × expr) × expr),
    if tup.snd = tup.fst.fst then tup.fst.snd
    else if tup.snd = tup.fst.snd then tup.fst.fst
    else tup.snd),
  let eqs : list expr := list.zip_with (λ L R, `(@eq.{1} ℤ %%L %%R)) lhs rhs,
  g ← get_goals,
  gls ← mmap mk_meta_var eqs,
  set_goals $ g ++ gls,
  triv, -- to discharge the starting `true` goal
  repeat $ tactic.norm_num norm_swap.eval [] (interactive.loc.ns [none]),
  done

example : true := by do
  let l : list ℚ := [0, (2 : ℚ) / -2, -1, 3 / 5, 4],
  let l' := (do a ← l, b ← l, c ← l, pure ((a, b), c)),
  ic ← mk_instance_cache `(ℚ),
  -- we have to convert the provided `rat`s into numeral form for the goals
  -- to look like what they would usually: `⇑(swap -1 3) -4 = -4`, like with ℤ above
  el ← mmap (λ (tup : (ℚ × ℚ) × ℚ), do
    (_, a) ← ic.of_rat tup.fst.fst,
    (_, b) ← ic.of_rat tup.fst.snd,
    (_, c) ← ic.of_rat tup.snd,
    pure ((a, b), c)) l',
  (lhs : list expr) ← mmap (λ (tup : (expr × expr) × expr),
    to_expr ``((equiv.swap %%tup.fst.fst %%tup.fst.snd) %%tup.snd)) el,
  let rhs : list expr := el.map (λ (tup : (expr × expr) × expr),
    if tup.snd = tup.fst.fst then tup.fst.snd
    else if tup.snd = tup.fst.snd then tup.fst.fst
    else tup.snd),
  let eqs : list expr := list.zip_with (λ L R, `(@eq.{1} ℚ %%L %%R)) lhs rhs,
  g ← get_goals,
  gls ← mmap mk_meta_var eqs,
  set_goals $ g ++ gls,
  triv, -- to discharge the starting `true` goal
  repeat $ tactic.norm_num norm_swap.eval [] (interactive.loc.ns [none]),
  done

example : swap (3 : fin 7) 5 0 = 0 := by norm_num
example : swap (fin.succ 2 : fin 7) 5 0 = 0 := by norm_num
example : swap (3 : fin 7) 5 3 = 5 := by norm_num
example : swap (3 : fin 1) 5 0 = 0 := by norm_num
example : swap (3 : fin 7) 5 10 = 12 := by norm_fin
example : swap (2 : fin 7) 4 9 = 11 := by norm_fin
example : swap (3 : fin 7) 5 0 = 0 := by norm_num
example : swap (3 : fin 7) 12 9 = 2 := by norm_num
example : swap (0 : fin (1 + 2)) (1 : fin (nat.succ (1 + 1))) ((fin.succ 1) : fin 3) = 2 :=
by norm_num

-- norm_swap doesn't generate trace output on non-swap expressions
example : (1 : ℤ) = (1 : ℕ) := by norm_num


/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
import data.fintype.card
import data.finset.option

/-!
# fintype instances for option

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

open function
open_locale nat

universes u v

variables {α β γ : Type*}

open finset function

instance {α : Type*} [fintype α] : fintype (option α) :=
⟨univ.insert_none, λ a, by simp⟩

lemma univ_option (α : Type*) [fintype α] : (univ : finset (option α)) = insert_none univ := rfl

@[simp] theorem fintype.card_option {α : Type*} [fintype α] :
  fintype.card (option α) = fintype.card α + 1 :=
(finset.card_cons _).trans $ congr_arg2 _ (card_map _) rfl

/-- If `option α` is a `fintype` then so is `α` -/
def fintype_of_option {α : Type*} [fintype (option α)] : fintype α :=
⟨finset.erase_none (fintype.elems (option α)), λ x, mem_erase_none.mpr (fintype.complete (some x))⟩

/-- A type is a `fintype` if its successor (using `option`) is a `fintype`. -/
def fintype_of_option_equiv [fintype α] (f : α ≃ option β) : fintype β :=
by { haveI := fintype.of_equiv _ f, exact fintype_of_option }

namespace fintype

/-- A recursor principle for finite types, analogous to `nat.rec`. It effectively says
that every `fintype` is either `empty` or `option α`, up to an `equiv`. -/
def trunc_rec_empty_option {P : Type u → Sort v}
  (of_equiv : ∀ {α β}, α ≃ β → P α → P β)
  (h_empty : P pempty)
  (h_option : ∀ {α} [fintype α] [decidable_eq α], P α → P (option α))
  (α : Type u) [fintype α] [decidable_eq α] : trunc (P α) :=
begin
  suffices : ∀ n : ℕ, trunc (P (ulift $ fin n)),
  { apply trunc.bind (this (fintype.card α)),
    intro h,
    apply trunc.map _ (fintype.trunc_equiv_fin α),
    intro e,
    exact of_equiv (equiv.ulift.trans e.symm) h },
  intro n,
  induction n with n ih,
  { have : card pempty = card (ulift (fin 0)),
    { simp only [card_fin, card_pempty, card_ulift] },
    apply trunc.bind (trunc_equiv_of_card_eq this),
    intro e,
    apply trunc.mk,
    refine of_equiv e h_empty, },
  { have : card (option (ulift (fin n))) = card (ulift (fin n.succ)),
    { simp only [card_fin, card_option, card_ulift] },
    apply trunc.bind (trunc_equiv_of_card_eq this),
    intro e,
    apply trunc.map _ ih,
    intro ih,
    refine of_equiv e (h_option ih), },
end

/-- An induction principle for finite types, analogous to `nat.rec`. It effectively says
that every `fintype` is either `empty` or `option α`, up to an `equiv`. -/
@[elab_as_eliminator]
lemma induction_empty_option {P : Π (α : Type u) [fintype α], Prop}
  (of_equiv : ∀ α β [fintype β] (e : α ≃ β), @P α (@fintype.of_equiv α β ‹_› e.symm) → @P β ‹_›)
  (h_empty : P pempty)
  (h_option : ∀ α [fintype α], by exactI P α → P (option α))
  (α : Type u) [fintype α] : P α :=
begin
  obtain ⟨p⟩ := @trunc_rec_empty_option (λ α, ∀ h, @P α h)
    (λ α β e hα hβ, @of_equiv α β hβ e (hα _)) (λ _i, by convert h_empty)
    _ α _ (classical.dec_eq α),
  { exact p _ },
  { rintro α hα - Pα hα', resetI, convert h_option α (Pα _) }
end

end fintype

/-- An induction principle for finite types, analogous to `nat.rec`. It effectively says
that every `fintype` is either `empty` or `option α`, up to an `equiv`. -/
lemma finite.induction_empty_option {P : Type u → Prop}
  (of_equiv : ∀ {α β}, α ≃ β → P α → P β)
  (h_empty : P pempty)
  (h_option : ∀ {α} [fintype α], P α → P (option α))
  (α : Type u) [finite α] : P α :=
begin
  casesI nonempty_fintype α,
  refine fintype.induction_empty_option _ _ _ α,
  exacts [λ α β _, of_equiv, h_empty, @h_option]
end


/-
Copyright (c) 2021 Jakob Scholbach. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jakob Scholbach
-/
import category_theory.arrow
import category_theory.limits.preserves.shapes.terminal

/-!
# Lifting properties

This file defines the lifting property of two arrows in a category and shows basic properties of
this notion.
We also construct the subcategory consisting of those morphisms which have the right lifting
property with respect to arrows in a given diagram.

## Main results
- `has_lifting_property`: the definition of the lifting property
- `iso_has_right_lifting_property`: any isomorphism satisfies the right lifting property (rlp)
- `id_has_right_lifting_property`: any identity has the rlp
- `right_lifting_property_initial_iff`: spells out the rlp with respect to a map whose source is an
  initial object
- `right_lifting_subcat`: given a set of arrows `F : D → arrow C`, we construct the subcategory
  of those morphisms `p` in `C` that satisfy the rlp w.r.t. `F i`, for any element `i` of `D`.

## Tags
lifting property
-/

open category_theory.limits

namespace category_theory

universes v u v₁
variables {C : Type u} [category.{v} C]
variables {D : Type v₁}

variables {X Y Z : C}

/-- The lifting property of a morphism `i` with respect to a morphism `p`.
This can be interpreted as the right lifting property of `i` with respect to `p`,
or the left lifting property of `p` with respect to `i`. -/
class has_lifting_property (i p : arrow C) : Prop :=
(sq_has_lift : ∀ (sq : i ⟶ p), arrow.has_lift sq)

@[priority 100] -- see Note [lower instance priority]
instance has_lifting_property' {i p : arrow C} [has_lifting_property i p] (sq : i ⟶ p) :
  arrow.has_lift sq :=
has_lifting_property.sq_has_lift sq

/-- Any isomorphism has the right lifting property with respect to any map.
A    → X
↓i    ↓p≅
B    → Y
-/
lemma iso_has_right_lifting_property (i : arrow C) (p : X ≅ Y) :
  has_lifting_property i (arrow.mk p.hom) :=
⟨λ sq, ⟨⟨{ lift := sq.right ≫ p.inv, }⟩⟩⟩ -- the lift is obtained by p⁻¹ ∘ (B → Y)

/-- Any identity has the right lifting property with respect to any map. -/
lemma id_has_right_lifting_property (i : arrow C) : has_lifting_property i (arrow.mk (𝟙 X)) :=
iso_has_right_lifting_property i (iso.refl _)

/-- An equivalent characterization for right lifting with respect to a map `i` whose source is
initial.
∅ → X
↓   ↓
B → Y has a lifting iff there is a map B → X making the right part commute.
-/
lemma right_lifting_property_initial_iff (i p : arrow C) (h : is_initial i.left) :
  has_lifting_property i p ↔ ∀ {e : i.right ⟶ p.right}, ∃ l : i.right ⟶ p.left, l ≫ p.hom = e :=
begin
  fsplit,
  { introsI hlift e,
    have comm : (is_initial.to h p.left) ≫ p.hom = i.hom ≫ e :=
      is_initial.hom_ext h _ _,
    use arrow.lift (arrow.hom_mk comm),
    simp },
  { refine λ hlift, ⟨λ sq, _⟩,
    obtain ⟨l, hl⟩ : ∃ (l : i.right ⟶ p.left), l ≫ p.hom = sq.right := hlift,
    exact arrow.has_lift.mk ⟨l, is_initial.hom_ext h _ _⟩, }
end

/-- The condition of having the rlp with respect to a morphism `i` is stable under composition. -/
lemma has_right_lifting_property_comp {i : arrow C} {f : X ⟶ Y} {g : Y ⟶ Z}
  (hf : has_lifting_property i (arrow.mk f))
  (hg : has_lifting_property i (arrow.mk g)) :
  has_lifting_property i (arrow.mk (f ≫ g)) :=
{ sq_has_lift := λ sq1,
    -- construct a square i ⟶ f
    let sq2 : i ⟶ (arrow.mk f) := ⟨sq1.left, arrow.lift (arrow.square_to_snd sq1)⟩ in
    -- show that the lift of this square is a lift of i with respect to g ∘ f
    ⟨⟨⟨(arrow.lift sq2 : _ ⟶ _), by simp⟩⟩⟩ }

/-- The objects of the subcategory `right_lifting_subcategory` are the ones in the
underlying category. -/
def right_lifting_subcat (R : Type u) := R

instance right_lifting_subcat.inhabited  (R : Type u) [inhabited R] :
  inhabited (right_lifting_subcat R) :=
{ default := (default R : R) }

/-- The objects of the subcategory `right_lifting_subcategory` are the ones in the
underlying category. -/
def right_lifting_subcat.X {R : Type u} (x : right_lifting_subcat R) : R := x

lemma id_has_right_lifting_property' {F : D → arrow C} (X : C) :
  ∀ i : D, has_lifting_property (F i) (arrow.mk (𝟙 X)) :=
λ i, id_has_right_lifting_property (F i)

lemma has_right_lifting_property_comp'
  {F : D → arrow C} {f : X ⟶ Y} (hf : ∀ i : D, has_lifting_property (F i) (arrow.mk f))
  {g : Y ⟶ Z} (hg : ∀ i : D, has_lifting_property (F i) (arrow.mk g)) :
  ∀ i : D,  has_lifting_property (F i) (arrow.mk (f ≫ g)) :=
λ i, has_right_lifting_property_comp (hf i) (hg i)

/-- Given a set of arrows in C, indexed by `F : D → arrow C`,
we construct the (non-full) subcategory of `C`
spanned by those morphisms that have the right lifting property relative to all maps
of the form `F i`, where `i` is any element in `D`. -/
def right_lifting_subcategory (F : D → arrow C) : category (right_lifting_subcat C) :=
{ hom := λ X Y, { p : X ⟶ Y // ∀ {i : D}, has_lifting_property (F i) (arrow.mk p) },
  id := λ X, ⟨𝟙 X, id_has_right_lifting_property' X⟩,
  comp := λ X Y Z f g, ⟨f.val ≫ g.val, has_right_lifting_property_comp' f.property g.property⟩ }

end category_theory


import tactic
import .lesson3

noncomputable theory
open_locale classical

open PreHilbertPlane
open HilbertPlane

section plane_separation

variables {Ω : Type*} [HilbertPlane Ω]

variables {A B C : Ω}
variables {ℓ r s : Line Ω}

lemma auxiliary_point (ℓ : Line Ω) (h : collinear_triple A B C) (hA : ¬ A ∈ ℓ) (hB : ¬ B ∈ ℓ)
	(hC : ¬ C ∈ ℓ) (hAB : A ≠ B) (hAC : A ≠ C) (hBC : B ≠ C)  :
	∃ (D E : Ω), D ∈ ℓ ∧ ¬ E ∈ ℓ ∧ same_side ℓ A E ∧ (D * A * E) ∧
					¬ collinear_triple A B E ∧
					¬ collinear_triple E C B ∧
					¬ collinear_triple A C E  :=
begin
	obtain ⟨ m, ⟨hAm, hBm, hCm⟩ ⟩ := h,
	obtain rfl | ℓ_not_m := em(ℓ = m),
		tauto,
	have HD : ∃ (D : Ω), D ∈ ℓ ∧ D ∉ m := point_in_line_difference ℓ_not_m,
	rcases HD with ⟨D ,⟨hDℓ, hDm⟩⟩,
	have hDA : D ≠ A,
	{
		intro hda,
		subst hda,
		exact hDm hAm,
	},
	have HE : ∃ E : Ω, D * A * E := HilbertPlane.B2 hDA,
	cases HE with E hE,
	have hDAE : collinear_triple D A E := (HilbertPlane.B12 hE).2.2.2,
	rcases hDAE with ⟨ 	s, ⟨ hDs,hAs, hEs⟩⟩,

	have ℓ_not_s : ℓ ≠ s,
	{
		intro hℓs,
		subst hℓs,
		exact ℓ_not_m (false.rec (ℓ = m) (hA hAs)),
	},
	have E_notin_ℓ : E ∉ ℓ,
	{
		intro hEℓ,
		apply (HilbertPlane.B12 hE).2.1,
		apply distinct_lines_have_at_most_one_common_point ℓ_not_s hDℓ hDs hEℓ hEs,
	},
	have hAE : same_side ℓ A E,
	{
		unfold same_side,
		repeat {split},
		repeat {assumption},
		right,
		ext1,
		norm_num,
		rintros (rfl | rfl|  h), repeat {assumption},
		{
			intro hxℓ,
			have x_is_D : x = D,
			{
				apply distinct_lines_have_at_most_one_common_point ℓ_not_s,
				repeat {assumption},
				exact between_points_share_line hAs hEs h,
			},
			subst x_is_D,
			have hxAE : collinear_triple x A E := (HilbertPlane.B12 hE).2.2.2,
			have Hfin := HilbertPlane.B3 hxAE,
			unfold xor3 at Hfin,
			tauto,
		},
	},
	have E_notin_m : E ∉ m,
	{
		intro hEm,
		have hsm : s = m := I12 (HilbertPlane.B12 hE).2.2.1 hAs hEs hAm hEm,
		subst hsm,
		tauto,
	},
	use [D, E],
	unfold same_side at hAE,
	repeat {split},
	repeat {tauto},
	all_goals
	{
		intro h,
		obtain ⟨ t, ⟨ hAt, hBt, hEt⟩⟩ := h,
		have m_eq_t : m = t,
		{
			try {apply equal_lines_of_contain_two_points hAB; assumption,},
			try {apply equal_lines_of_contain_two_points hBC; assumption,},
			try {apply equal_lines_of_contain_two_points hAC; assumption,},
		},
		subst m_eq_t,
		tauto,
	},
end

lemma same_side.trans : same_side ℓ A B → same_side ℓ B C → same_side ℓ A C :=
begin
intros hAB hBC,
by_cases ¬ collinear_triple A B C,
{
	apply same_side_trans_of_noncollinear _ hAB hBC,
	rw collinear_triple_of_equal A C B A B C,
	exact h,
},
{
	-- A B C collinear
	push_neg at h,
	obtain rfl | hAeqB := em(A = B), assumption,
	obtain rfl | hBeqC := em(B = C), assumption,
	obtain rfl | hAeqC := em(A = C), exact same_side.refl,
    have H1 := point_on_line_of_same_side hAB,
    have H2 := point_on_line_of_same_side hBC,
    by_cases hAℓ : A ∈ ℓ,
    {
        left,
        split;
        {
            try {rw [←H2, ←H1]},
            exact hAℓ,
        },
    },
	obtain ⟨D,E, ⟨ hDℓ, hEℓ, hAE, hDAE, hABE, hECB, hACE⟩⟩ :=
		auxiliary_point ℓ h _ _ _ _ _ _,
	{
		rw collinear_triple_of_equal A B E B E A at hABE,
		have hBE : same_side ℓ B E :=
			same_side_trans_of_noncollinear hABE (same_side.symm hAB) hAE,
		have hEC : same_side ℓ E C :=
			same_side_trans_of_noncollinear hECB (same_side.symm hBE) hBC,
		apply same_side_trans_of_noncollinear hACE hAE hEC,
	},
	repeat {tauto},
},
end

end plane_separation


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

! This file was ported from Lean 3 source module algebra.module.pointwise_pi
! leanprover-community/mathlib commit f2f413b9d4be3a02840d0663dace76e8fe3da053
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Set.Pointwise.Smul
import Mathbin.GroupTheory.GroupAction.Pi

/-!
# Pointwise actions on sets in Pi types

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

This file contains lemmas about pointwise actions on sets in Pi types.

## Tags

set multiplication, set addition, pointwise addition, pointwise multiplication, pi

-/

open Pointwise

open Set

variable {K ι : Type _} {R : ι → Type _}

/- warning: smul_pi_subset -> smul_pi_subset is a dubious translation:
lean 3 declaration is
  forall {K : Type.{u1}} {ι : Type.{u2}} {R : ι -> Type.{u3}} [_inst_1 : forall (i : ι), SMul.{u1, u3} K (R i)] (r : K) (s : Set.{u2} ι) (t : forall (i : ι), Set.{u3} (R i)), HasSubset.Subset.{max u2 u3} (Set.{max u2 u3} (forall (i : ι), R i)) (Set.hasSubset.{max u2 u3} (forall (i : ι), R i)) (SMul.smul.{u1, max u2 u3} K (Set.{max u2 u3} (forall (i : ι), R i)) (Set.smulSet.{u1, max u2 u3} K (forall (i : ι), R i) (Pi.instSMul.{u2, u3, u1} ι K (fun (i : ι) => R i) (fun (i : ι) => _inst_1 i))) r (Set.pi.{u2, u3} ι (fun (i : ι) => R i) s t)) (Set.pi.{u2, u3} ι (fun (i : ι) => R i) s (SMul.smul.{u1, max u2 u3} K (forall (i : ι), Set.{u3} (R i)) (Pi.instSMul.{u2, u3, u1} ι K (fun (i : ι) => Set.{u3} (R i)) (fun (i : ι) => Set.smulSet.{u1, u3} K (R i) (_inst_1 i))) r t))
but is expected to have type
  forall {K : Type.{u3}} {ι : Type.{u1}} {R : ι -> Type.{u2}} [_inst_1 : forall (i : ι), SMul.{u3, u2} K (R i)] (r : K) (s : Set.{u1} ι) (t : forall (i : ι), Set.{u2} (R i)), HasSubset.Subset.{max u1 u2} (Set.{max u1 u2} (forall (i : ι), R i)) (Set.instHasSubsetSet.{max u1 u2} (forall (i : ι), R i)) (HSMul.hSMul.{u3, max u2 u1, max u1 u2} K (Set.{max u1 u2} (forall (i : ι), R i)) (Set.{max u1 u2} (forall (i : ι), R i)) (instHSMul.{u3, max u1 u2} K (Set.{max u1 u2} (forall (i : ι), R i)) (Set.smulSet.{u3, max u1 u2} K (forall (i : ι), R i) (Pi.instSMul.{u1, u2, u3} ι K (fun (i : ι) => R i) (fun (i : ι) => _inst_1 i)))) r (Set.pi.{u1, u2} ι (fun (i : ι) => R i) s t)) (Set.pi.{u1, u2} ι (fun (i : ι) => R i) s (HSMul.hSMul.{u3, max u1 u2, max u1 u2} K (forall (i : ι), Set.{u2} (R i)) (forall (i : ι), Set.{u2} (R i)) (instHSMul.{u3, max u1 u2} K (forall (i : ι), Set.{u2} (R i)) (Pi.instSMul.{u1, u2, u3} ι K (fun (i : ι) => Set.{u2} (R i)) (fun (i : ι) => Set.smulSet.{u3, u2} K (R i) (_inst_1 i)))) r t))
Case conversion may be inaccurate. Consider using '#align smul_pi_subset smul_pi_subsetₓ'. -/
@[to_additive]
theorem smul_pi_subset [∀ i, SMul K (R i)] (r : K) (s : Set ι) (t : ∀ i, Set (R i)) :
    r • pi s t ⊆ pi s (r • t) := by
  rintro x ⟨y, h, rfl⟩ i hi
  exact smul_mem_smul_set (h i hi)
#align smul_pi_subset smul_pi_subset
#align vadd_pi_subset vadd_pi_subset

/- warning: smul_univ_pi -> smul_univ_pi is a dubious translation:
lean 3 declaration is
  forall {K : Type.{u1}} {ι : Type.{u2}} {R : ι -> Type.{u3}} [_inst_1 : forall (i : ι), SMul.{u1, u3} K (R i)] (r : K) (t : forall (i : ι), Set.{u3} (R i)), Eq.{succ (max u2 u3)} (Set.{max u2 u3} (forall (i : ι), R i)) (SMul.smul.{u1, max u2 u3} K (Set.{max u2 u3} (forall (i : ι), R i)) (Set.smulSet.{u1, max u2 u3} K (forall (i : ι), R i) (Pi.instSMul.{u2, u3, u1} ι K (fun (i : ι) => R i) (fun (i : ι) => _inst_1 i))) r (Set.pi.{u2, u3} ι (fun (i : ι) => R i) (Set.univ.{u2} ι) t)) (Set.pi.{u2, u3} ι (fun (i : ι) => R i) (Set.univ.{u2} ι) (SMul.smul.{u1, max u2 u3} K (forall (i : ι), Set.{u3} (R i)) (Pi.instSMul.{u2, u3, u1} ι K (fun (i : ι) => Set.{u3} (R i)) (fun (i : ι) => Set.smulSet.{u1, u3} K (R i) (_inst_1 i))) r t))
but is expected to have type
  forall {K : Type.{u3}} {ι : Type.{u1}} {R : ι -> Type.{u2}} [_inst_1 : forall (i : ι), SMul.{u3, u2} K (R i)] (r : K) (t : forall (i : ι), Set.{u2} (R i)), Eq.{max (succ u1) (succ u2)} (Set.{max u1 u2} (forall (i : ι), R i)) (HSMul.hSMul.{u3, max u2 u1, max u1 u2} K (Set.{max u1 u2} (forall (i : ι), R i)) (Set.{max u1 u2} (forall (i : ι), R i)) (instHSMul.{u3, max u1 u2} K (Set.{max u1 u2} (forall (i : ι), R i)) (Set.smulSet.{u3, max u1 u2} K (forall (i : ι), R i) (Pi.instSMul.{u1, u2, u3} ι K (fun (i : ι) => R i) (fun (i : ι) => _inst_1 i)))) r (Set.pi.{u1, u2} ι (fun (i : ι) => R i) (Set.univ.{u1} ι) t)) (Set.pi.{u1, u2} ι (fun (i : ι) => R i) (Set.univ.{u1} ι) (HSMul.hSMul.{u3, max u1 u2, max u1 u2} K (forall (i : ι), Set.{u2} (R i)) (forall (i : ι), Set.{u2} (R i)) (instHSMul.{u3, max u1 u2} K (forall (i : ι), Set.{u2} (R i)) (Pi.instSMul.{u1, u2, u3} ι K (fun (i : ι) => Set.{u2} (R i)) (fun (i : ι) => Set.smulSet.{u3, u2} K (R i) (_inst_1 i)))) r t))
Case conversion may be inaccurate. Consider using '#align smul_univ_pi smul_univ_piₓ'. -/
@[to_additive]
theorem smul_univ_pi [∀ i, SMul K (R i)] (r : K) (t : ∀ i, Set (R i)) :
    r • pi (univ : Set ι) t = pi (univ : Set ι) (r • t) :=
  Subset.antisymm (smul_pi_subset _ _ _) fun x h =>
    by
    refine' ⟨fun i => Classical.choose (h i <| Set.mem_univ _), fun i hi => _, funext fun i => _⟩
    · exact (Classical.choose_spec (h i _)).left
    · exact (Classical.choose_spec (h i _)).right
#align smul_univ_pi smul_univ_pi
#align vadd_univ_pi vadd_univ_pi

/- warning: smul_pi -> smul_pi is a dubious translation:
lean 3 declaration is
  forall {K : Type.{u1}} {ι : Type.{u2}} {R : ι -> Type.{u3}} [_inst_1 : Group.{u1} K] [_inst_2 : forall (i : ι), MulAction.{u1, u3} K (R i) (DivInvMonoid.toMonoid.{u1} K (Group.toDivInvMonoid.{u1} K _inst_1))] (r : K) (S : Set.{u2} ι) (t : forall (i : ι), Set.{u3} (R i)), Eq.{succ (max u2 u3)} (Set.{max u2 u3} (forall (i : ι), R i)) (SMul.smul.{u1, max u2 u3} K (Set.{max u2 u3} (forall (i : ι), R i)) (Set.smulSet.{u1, max u2 u3} K (forall (i : ι), R i) (Pi.instSMul.{u2, u3, u1} ι K (fun (i : ι) => R i) (fun (i : ι) => MulAction.toHasSmul.{u1, u3} K (R i) (DivInvMonoid.toMonoid.{u1} K (Group.toDivInvMonoid.{u1} K _inst_1)) (_inst_2 i)))) r (Set.pi.{u2, u3} ι (fun (i : ι) => R i) S t)) (Set.pi.{u2, u3} ι (fun (i : ι) => R i) S (SMul.smul.{u1, max u2 u3} K (forall (i : ι), Set.{u3} (R i)) (Pi.instSMul.{u2, u3, u1} ι K (fun (i : ι) => Set.{u3} (R i)) (fun (i : ι) => Set.smulSet.{u1, u3} K (R i) (MulAction.toHasSmul.{u1, u3} K (R i) (DivInvMonoid.toMonoid.{u1} K (Group.toDivInvMonoid.{u1} K _inst_1)) (_inst_2 i)))) r t))
but is expected to have type
  forall {K : Type.{u3}} {ι : Type.{u1}} {R : ι -> Type.{u2}} [_inst_1 : Group.{u3} K] [_inst_2 : forall (i : ι), MulAction.{u3, u2} K (R i) (DivInvMonoid.toMonoid.{u3} K (Group.toDivInvMonoid.{u3} K _inst_1))] (r : K) (S : Set.{u1} ι) (t : forall (i : ι), Set.{u2} (R i)), Eq.{max (succ u1) (succ u2)} (Set.{max u1 u2} (forall (i : ι), R i)) (HSMul.hSMul.{u3, max u1 u2, max u1 u2} K (Set.{max u1 u2} (forall (i : ι), R i)) (Set.{max u1 u2} (forall (i : ι), R i)) (instHSMul.{u3, max u1 u2} K (Set.{max u1 u2} (forall (i : ι), R i)) (Set.smulSet.{u3, max u1 u2} K (forall (i : ι), R i) (Pi.instSMul.{u1, u2, u3} ι K (fun (i : ι) => R i) (fun (i : ι) => MulAction.toSMul.{u3, u2} K (R i) (DivInvMonoid.toMonoid.{u3} K (Group.toDivInvMonoid.{u3} K _inst_1)) (_inst_2 i))))) r (Set.pi.{u1, u2} ι (fun (i : ι) => R i) S t)) (Set.pi.{u1, u2} ι (fun (i : ι) => R i) S (HSMul.hSMul.{u3, max u1 u2, max u1 u2} K (forall (i : ι), Set.{u2} (R i)) (forall (i : ι), Set.{u2} (R i)) (instHSMul.{u3, max u1 u2} K (forall (i : ι), Set.{u2} (R i)) (Pi.instSMul.{u1, u2, u3} ι K (fun (i : ι) => Set.{u2} (R i)) (fun (i : ι) => Set.smulSet.{u3, u2} K (R i) (MulAction.toSMul.{u3, u2} K (R i) (DivInvMonoid.toMonoid.{u3} K (Group.toDivInvMonoid.{u3} K _inst_1)) (_inst_2 i))))) r t))
Case conversion may be inaccurate. Consider using '#align smul_pi smul_piₓ'. -/
@[to_additive]
theorem smul_pi [Group K] [∀ i, MulAction K (R i)] (r : K) (S : Set ι) (t : ∀ i, Set (R i)) :
    r • S.pi t = S.pi (r • t) :=
  Subset.antisymm (smul_pi_subset _ _ _) fun x h =>
    ⟨r⁻¹ • x, fun i hiS => mem_smul_set_iff_inv_smul_mem.mp (h i hiS), smul_inv_smul _ _⟩
#align smul_pi smul_pi
#align vadd_pi vadd_pi

/- warning: smul_pi₀ -> smul_pi₀ is a dubious translation:
lean 3 declaration is
  forall {K : Type.{u1}} {ι : Type.{u2}} {R : ι -> Type.{u3}} [_inst_1 : GroupWithZero.{u1} K] [_inst_2 : forall (i : ι), MulAction.{u1, u3} K (R i) (MonoidWithZero.toMonoid.{u1} K (GroupWithZero.toMonoidWithZero.{u1} K _inst_1))] {r : K} (S : Set.{u2} ι) (t : forall (i : ι), Set.{u3} (R i)), (Ne.{succ u1} K r (OfNat.ofNat.{u1} K 0 (OfNat.mk.{u1} K 0 (Zero.zero.{u1} K (MulZeroClass.toHasZero.{u1} K (MulZeroOneClass.toMulZeroClass.{u1} K (MonoidWithZero.toMulZeroOneClass.{u1} K (GroupWithZero.toMonoidWithZero.{u1} K _inst_1)))))))) -> (Eq.{succ (max u2 u3)} (Set.{max u2 u3} (forall (i : ι), R i)) (SMul.smul.{u1, max u2 u3} K (Set.{max u2 u3} (forall (i : ι), R i)) (Set.smulSet.{u1, max u2 u3} K (forall (i : ι), R i) (Pi.instSMul.{u2, u3, u1} ι K (fun (i : ι) => R i) (fun (i : ι) => MulAction.toHasSmul.{u1, u3} K (R i) (MonoidWithZero.toMonoid.{u1} K (GroupWithZero.toMonoidWithZero.{u1} K _inst_1)) (_inst_2 i)))) r (Set.pi.{u2, u3} ι (fun (i : ι) => R i) S t)) (Set.pi.{u2, u3} ι (fun (i : ι) => R i) S (SMul.smul.{u1, max u2 u3} K (forall (i : ι), Set.{u3} (R i)) (Pi.instSMul.{u2, u3, u1} ι K (fun (i : ι) => Set.{u3} (R i)) (fun (i : ι) => Set.smulSet.{u1, u3} K (R i) (MulAction.toHasSmul.{u1, u3} K (R i) (MonoidWithZero.toMonoid.{u1} K (GroupWithZero.toMonoidWithZero.{u1} K _inst_1)) (_inst_2 i)))) r t)))
but is expected to have type
  forall {K : Type.{u3}} {ι : Type.{u1}} {R : ι -> Type.{u2}} [_inst_1 : GroupWithZero.{u3} K] [_inst_2 : forall (i : ι), MulAction.{u3, u2} K (R i) (MonoidWithZero.toMonoid.{u3} K (GroupWithZero.toMonoidWithZero.{u3} K _inst_1))] {r : K} (S : Set.{u1} ι) (t : forall (i : ι), Set.{u2} (R i)), (Ne.{succ u3} K r (OfNat.ofNat.{u3} K 0 (Zero.toOfNat0.{u3} K (MonoidWithZero.toZero.{u3} K (GroupWithZero.toMonoidWithZero.{u3} K _inst_1))))) -> (Eq.{max (succ u1) (succ u2)} (Set.{max u1 u2} (forall (i : ι), R i)) (HSMul.hSMul.{u3, max u1 u2, max u1 u2} K (Set.{max u1 u2} (forall (i : ι), R i)) (Set.{max u1 u2} (forall (i : ι), R i)) (instHSMul.{u3, max u1 u2} K (Set.{max u1 u2} (forall (i : ι), R i)) (Set.smulSet.{u3, max u1 u2} K (forall (i : ι), R i) (Pi.instSMul.{u1, u2, u3} ι K (fun (i : ι) => R i) (fun (i : ι) => MulAction.toSMul.{u3, u2} K (R i) (MonoidWithZero.toMonoid.{u3} K (GroupWithZero.toMonoidWithZero.{u3} K _inst_1)) (_inst_2 i))))) r (Set.pi.{u1, u2} ι (fun (i : ι) => R i) S t)) (Set.pi.{u1, u2} ι (fun (i : ι) => R i) S (HSMul.hSMul.{u3, max u1 u2, max u1 u2} K (forall (i : ι), Set.{u2} (R i)) (forall (i : ι), Set.{u2} (R i)) (instHSMul.{u3, max u1 u2} K (forall (i : ι), Set.{u2} (R i)) (Pi.instSMul.{u1, u2, u3} ι K (fun (i : ι) => Set.{u2} (R i)) (fun (i : ι) => Set.smulSet.{u3, u2} K (R i) (MulAction.toSMul.{u3, u2} K (R i) (MonoidWithZero.toMonoid.{u3} K (GroupWithZero.toMonoidWithZero.{u3} K _inst_1)) (_inst_2 i))))) r t)))
Case conversion may be inaccurate. Consider using '#align smul_pi₀ smul_pi₀ₓ'. -/
theorem smul_pi₀ [GroupWithZero K] [∀ i, MulAction K (R i)] {r : K} (S : Set ι) (t : ∀ i, Set (R i))
    (hr : r ≠ 0) : r • S.pi t = S.pi (r • t) :=
  smul_pi (Units.mk0 r hr) S t
#align smul_pi₀ smul_pi₀


/-
Copyright (c) 2019 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel
-/
import topology.metric_space.isometry
import topology.instances.ennreal
import analysis.specific_limits

/-!
# Hausdorff distance

The Hausdorff distance on subsets of a metric (or emetric) space.

Given two subsets `s` and `t` of a metric space, their Hausdorff distance is the smallest `d`
such that any point `s` is within `d` of a point in `t`, and conversely. This quantity
is often infinite (think of `s` bounded and `t` unbounded), and therefore better
expressed in the setting of emetric spaces.

## Main definitions

This files introduces:
* `inf_edist x s`, the infimum edistance of a point `x` to a set `s` in an emetric space
* `Hausdorff_edist s t`, the Hausdorff edistance of two sets in an emetric space
* Versions of these notions on metric spaces, called respectively `inf_dist` and `Hausdorff_dist`
* `thickening δ s`, the open thickening by radius `δ` of a set `s` in a pseudo emetric space.
* `cthickening δ s`, the closed thickening by radius `δ` of a set `s` in a pseudo emetric space.
-/
noncomputable theory
open_locale classical nnreal ennreal topological_space
universes u v w

open classical set function topological_space filter

namespace emetric

section inf_edist

variables {α : Type u} {β : Type v} [pseudo_emetric_space α] [pseudo_emetric_space β] {x y : α}
{s t : set α} {Φ : α → β}

/-! ### Distance of a point to a set as a function into `ℝ≥0∞`. -/

/-- The minimal edistance of a point to a set -/
def inf_edist (x : α) (s : set α) : ℝ≥0∞ := ⨅ y ∈ s, edist x y

@[simp] lemma inf_edist_empty : inf_edist x ∅ = ∞ := infi_emptyset

lemma le_inf_edist {d} : d ≤ inf_edist x s ↔ ∀ y ∈ s, d ≤ edist x y :=
by simp only [inf_edist, le_infi_iff]

/-- The edist to a union is the minimum of the edists -/
@[simp] lemma inf_edist_union : inf_edist x (s ∪ t) = inf_edist x s ⊓ inf_edist x t :=
infi_union

/-- The edist to a singleton is the edistance to the single point of this singleton -/
@[simp] lemma inf_edist_singleton : inf_edist x {y} = edist x y :=
infi_singleton

/-- The edist to a set is bounded above by the edist to any of its points -/
lemma inf_edist_le_edist_of_mem (h : y ∈ s) : inf_edist x s ≤ edist x y :=
binfi_le _ h

/-- If a point `x` belongs to `s`, then its edist to `s` vanishes -/
lemma inf_edist_zero_of_mem (h : x ∈ s) : inf_edist x s = 0 :=
nonpos_iff_eq_zero.1 $ @edist_self _ _ x ▸ inf_edist_le_edist_of_mem h

/-- The edist is monotonous with respect to inclusion -/
lemma inf_edist_le_inf_edist_of_subset (h : s ⊆ t) : inf_edist x t ≤ inf_edist x s :=
infi_le_infi_of_subset h

/-- If the edist to a set is `< r`, there exists a point in the set at edistance `< r` -/
lemma exists_edist_lt_of_inf_edist_lt {r : ℝ≥0∞} (h : inf_edist x s < r) :
  ∃y∈s, edist x y < r :=
by simpa only [inf_edist, infi_lt_iff] using h

/-- The edist of `x` to `s` is bounded by the sum of the edist of `y` to `s` and
the edist from `x` to `y` -/
lemma inf_edist_le_inf_edist_add_edist : inf_edist x s ≤ inf_edist y s + edist x y :=
calc (⨅ z ∈ s, edist x z) ≤ ⨅ z ∈ s, edist y z + edist x y :
  binfi_le_binfi $ λ z hz, (edist_triangle _ _ _).trans_eq (add_comm _ _)
... = (⨅ z ∈ s, edist y z) + edist x y : by simp only [ennreal.infi_add]

/-- The edist to a set depends continuously on the point -/
@[continuity]
lemma continuous_inf_edist : continuous (λx, inf_edist x s) :=
continuous_of_le_add_edist 1 (by simp) $
  by simp only [one_mul, inf_edist_le_inf_edist_add_edist, forall_2_true_iff]

/-- The edist to a set and to its closure coincide -/
lemma inf_edist_closure : inf_edist x (closure s) = inf_edist x s :=
begin
  refine le_antisymm (inf_edist_le_inf_edist_of_subset subset_closure) _,
  refine ennreal.le_of_forall_pos_le_add (λε εpos h, _),
  have ε0 : 0 < (ε / 2 : ℝ≥0∞) := by simpa [pos_iff_ne_zero] using εpos,
  have : inf_edist x (closure s) < inf_edist x (closure s) + ε/2,
    from ennreal.lt_add_right h.ne ε0.ne',
  rcases exists_edist_lt_of_inf_edist_lt this with ⟨y, ycs, hy⟩,
  -- y : α,  ycs : y ∈ closure s,  hy : edist x y < inf_edist x (closure s) + ↑ε / 2
  rcases emetric.mem_closure_iff.1 ycs (ε/2) ε0 with ⟨z, zs, dyz⟩,
  -- z : α,  zs : z ∈ s,  dyz : edist y z < ↑ε / 2
  calc inf_edist x s ≤ edist x z : inf_edist_le_edist_of_mem zs
        ... ≤ edist x y + edist y z : edist_triangle _ _ _
        ... ≤ (inf_edist x (closure s) + ε / 2) + (ε/2) : add_le_add (le_of_lt hy) (le_of_lt dyz)
        ... = inf_edist x (closure s) + ↑ε : by rw [add_assoc, ennreal.add_halves]
end

/-- A point belongs to the closure of `s` iff its infimum edistance to this set vanishes -/
lemma mem_closure_iff_inf_edist_zero : x ∈ closure s ↔ inf_edist x s = 0 :=
⟨λh, by rw ← inf_edist_closure; exact inf_edist_zero_of_mem h,
λh, emetric.mem_closure_iff.2 $ λε εpos, exists_edist_lt_of_inf_edist_lt (by rwa h)⟩

/-- Given a closed set `s`, a point belongs to `s` iff its infimum edistance to this set vanishes -/
lemma mem_iff_inf_edist_zero_of_closed (h : is_closed s) : x ∈ s ↔ inf_edist x s = 0 :=
begin
  convert ← mem_closure_iff_inf_edist_zero,
  exact h.closure_eq
end

lemma disjoint_closed_ball_of_lt_inf_edist {r : ℝ≥0∞} (h : r < inf_edist x s) :
  disjoint (closed_ball x r) s :=
begin
  rw disjoint_left,
  assume y hy h'y,
  apply lt_irrefl (inf_edist x s),
  calc inf_edist x s ≤ edist x y : inf_edist_le_edist_of_mem h'y
  ... ≤ r : by rwa [mem_closed_ball, edist_comm] at hy
  ... < inf_edist x s : h
end

/-- The infimum edistance is invariant under isometries -/
lemma inf_edist_image (hΦ : isometry Φ) :
  inf_edist (Φ x) (Φ '' t) = inf_edist x t :=
by simp only [inf_edist, infi_image, hΦ.edist_eq]

lemma _root_.is_open.exists_Union_is_closed {U : set α} (hU : is_open U) :
  ∃ F : ℕ → set α, (∀ n, is_closed (F n)) ∧ (∀ n, F n ⊆ U) ∧ ((⋃ n, F n) = U) ∧ (monotone F) :=
begin
  obtain ⟨a, a_pos, a_lt_one⟩ : ∃ (a : ℝ≥0∞), 0 < a ∧ a < 1 := exists_between (ennreal.zero_lt_one),
  let F := λ (n : ℕ), (λ x, inf_edist x Uᶜ) ⁻¹' (Ici (a^n)),
  have F_subset : ∀ n, F n ⊆ U,
  { assume n x hx,
    by_contra h,
    rw [← mem_compl_iff,
      mem_iff_inf_edist_zero_of_closed (is_open.is_closed_compl hU)] at h,
    have : 0 < inf_edist x Uᶜ := lt_of_lt_of_le (ennreal.pow_pos a_pos _) hx,
    rw h at this,
    exact lt_irrefl _ this },
  refine ⟨F, λ n, is_closed.preimage continuous_inf_edist is_closed_Ici, F_subset, _, _⟩,
  show monotone F,
  { assume m n hmn x hx,
    simp only [mem_Ici, mem_preimage] at hx ⊢,
    apply le_trans (ennreal.pow_le_pow_of_le_one a_lt_one.le hmn) hx },
  show (⋃ n, F n) = U,
  { refine subset.antisymm (by simp only [Union_subset_iff, F_subset, forall_const]) (λ x hx, _),
    have : ¬(x ∈ Uᶜ), by simpa using hx,
    rw mem_iff_inf_edist_zero_of_closed (is_open.is_closed_compl hU) at this,
    have B : 0 < inf_edist x Uᶜ, by simpa [pos_iff_ne_zero] using this,
    have : filter.tendsto (λ n, a^n) at_top (𝓝 0) :=
      ennreal.tendsto_pow_at_top_nhds_0_of_lt_1 a_lt_one,
    rcases ((tendsto_order.1 this).2 _ B).exists with ⟨n, hn⟩,
    simp only [mem_Union, mem_Ici, mem_preimage],
    exact ⟨n, hn.le⟩ },
end

end inf_edist --section

/-! ### The Hausdorff distance as a function into `ℝ≥0∞`. -/

/-- The Hausdorff edistance between two sets is the smallest `r` such that each set
is contained in the `r`-neighborhood of the other one -/
@[irreducible] def Hausdorff_edist {α : Type u} [pseudo_emetric_space α] (s t : set α) : ℝ≥0∞ :=
(⨆ x ∈ s, inf_edist x t) ⊔ (⨆ y ∈ t, inf_edist y s)

lemma Hausdorff_edist_def {α : Type u} [pseudo_emetric_space α] (s t : set α) :
  Hausdorff_edist s t = (⨆ x ∈ s, inf_edist x t) ⊔ (⨆ y ∈ t, inf_edist y s) :=
by rw Hausdorff_edist

section Hausdorff_edist

variables {α : Type u} {β : Type v} [pseudo_emetric_space α] [pseudo_emetric_space β]
          {x y : α} {s t u : set α} {Φ : α → β}

/-- The Hausdorff edistance of a set to itself vanishes -/
@[simp] lemma Hausdorff_edist_self : Hausdorff_edist s s = 0 :=
begin
  simp only [Hausdorff_edist_def, sup_idem, ennreal.supr_eq_zero],
  exact λ x hx, inf_edist_zero_of_mem hx
end

/-- The Haudorff edistances of `s` to `t` and of `t` to `s` coincide -/
lemma Hausdorff_edist_comm : Hausdorff_edist s t = Hausdorff_edist t s :=
by unfold Hausdorff_edist; apply sup_comm

/-- Bounding the Hausdorff edistance by bounding the edistance of any point
in each set to the other set -/
lemma Hausdorff_edist_le_of_inf_edist {r : ℝ≥0∞}
  (H1 : ∀x ∈ s, inf_edist x t ≤ r) (H2 : ∀x ∈ t, inf_edist x s ≤ r) :
  Hausdorff_edist s t ≤ r :=
begin
  simp only [Hausdorff_edist, sup_le_iff, supr_le_iff],
  exact ⟨H1, H2⟩
end

/-- Bounding the Hausdorff edistance by exhibiting, for any point in each set,
another point in the other set at controlled distance -/
lemma Hausdorff_edist_le_of_mem_edist {r : ℝ≥0∞}
  (H1 : ∀x ∈ s, ∃y ∈ t, edist x y ≤ r) (H2 : ∀x ∈ t, ∃y ∈ s, edist x y ≤ r) :
  Hausdorff_edist s t ≤ r :=
begin
  refine Hausdorff_edist_le_of_inf_edist _ _,
  { assume x xs,
    rcases H1 x xs with ⟨y, yt, hy⟩,
    exact le_trans (inf_edist_le_edist_of_mem yt) hy },
  { assume x xt,
    rcases H2 x xt with ⟨y, ys, hy⟩,
    exact le_trans (inf_edist_le_edist_of_mem ys) hy }
end

/-- The distance to a set is controlled by the Hausdorff distance -/
lemma inf_edist_le_Hausdorff_edist_of_mem (h : x ∈ s) : inf_edist x t ≤ Hausdorff_edist s t :=
begin
  rw Hausdorff_edist_def,
  refine le_trans _ le_sup_left,
  exact le_bsupr x h
end

/-- If the Hausdorff distance is `<r`, then any point in one of the sets has
a corresponding point at distance `<r` in the other set -/
lemma exists_edist_lt_of_Hausdorff_edist_lt {r : ℝ≥0∞} (h : x ∈ s)
  (H : Hausdorff_edist s t < r) :
  ∃y∈t, edist x y < r :=
exists_edist_lt_of_inf_edist_lt $ calc
  inf_edist x t ≤ Hausdorff_edist s t : inf_edist_le_Hausdorff_edist_of_mem h
  ... < r : H

/-- The distance from `x` to `s` or `t` is controlled in terms of the Hausdorff distance
between `s` and `t` -/
lemma inf_edist_le_inf_edist_add_Hausdorff_edist :
  inf_edist x t ≤ inf_edist x s + Hausdorff_edist s t :=
ennreal.le_of_forall_pos_le_add $ λε εpos h, begin
  have ε0 : (ε / 2 : ℝ≥0∞) ≠ 0 := by simpa [pos_iff_ne_zero] using εpos,
  have : inf_edist x s < inf_edist x s + ε/2 :=
    ennreal.lt_add_right (ennreal.add_lt_top.1 h).1.ne ε0,
  rcases exists_edist_lt_of_inf_edist_lt this with ⟨y, ys, dxy⟩,
  -- y : α,  ys : y ∈ s,  dxy : edist x y < inf_edist x s + ↑ε / 2
  have : Hausdorff_edist s t < Hausdorff_edist s t + ε/2 :=
    ennreal.lt_add_right (ennreal.add_lt_top.1 h).2.ne ε0,
  rcases exists_edist_lt_of_Hausdorff_edist_lt ys this with ⟨z, zt, dyz⟩,
  -- z : α,  zt : z ∈ t,  dyz : edist y z < Hausdorff_edist s t + ↑ε / 2
  calc inf_edist x t ≤ edist x z : inf_edist_le_edist_of_mem zt
    ... ≤ edist x y + edist y z : edist_triangle _ _ _
    ... ≤ (inf_edist x s + ε/2) + (Hausdorff_edist s t + ε/2) : add_le_add dxy.le dyz.le
    ... = inf_edist x s + Hausdorff_edist s t + ε :
      by simp [ennreal.add_halves, add_comm, add_left_comm]
end

/-- The Hausdorff edistance is invariant under eisometries -/
lemma Hausdorff_edist_image (h : isometry Φ) :
  Hausdorff_edist (Φ '' s) (Φ '' t) = Hausdorff_edist s t :=
by simp only [Hausdorff_edist_def, supr_image, inf_edist_image h]

/-- The Hausdorff distance is controlled by the diameter of the union -/
lemma Hausdorff_edist_le_ediam (hs : s.nonempty) (ht : t.nonempty) :
  Hausdorff_edist s t ≤ diam (s ∪ t) :=
begin
  rcases hs with ⟨x, xs⟩,
  rcases ht with ⟨y, yt⟩,
  refine Hausdorff_edist_le_of_mem_edist _ _,
  { intros z hz,
    exact ⟨y, yt, edist_le_diam_of_mem (subset_union_left _ _ hz) (subset_union_right _ _ yt)⟩ },
  { intros z hz,
    exact ⟨x, xs, edist_le_diam_of_mem (subset_union_right _ _ hz) (subset_union_left _ _ xs)⟩ }
end

/-- The Hausdorff distance satisfies the triangular inequality -/
lemma Hausdorff_edist_triangle : Hausdorff_edist s u ≤ Hausdorff_edist s t + Hausdorff_edist t u :=
begin
  rw Hausdorff_edist_def,
  simp only [sup_le_iff, supr_le_iff],
  split,
  show ∀x ∈ s, inf_edist x u ≤ Hausdorff_edist s t + Hausdorff_edist t u, from λx xs, calc
    inf_edist x u ≤ inf_edist x t + Hausdorff_edist t u : inf_edist_le_inf_edist_add_Hausdorff_edist
    ... ≤ Hausdorff_edist s t + Hausdorff_edist t u :
      add_le_add_right (inf_edist_le_Hausdorff_edist_of_mem  xs) _,
  show ∀x ∈ u, inf_edist x s ≤ Hausdorff_edist s t + Hausdorff_edist t u, from λx xu, calc
    inf_edist x s ≤ inf_edist x t + Hausdorff_edist t s : inf_edist_le_inf_edist_add_Hausdorff_edist
    ... ≤ Hausdorff_edist u t + Hausdorff_edist t s :
      add_le_add_right (inf_edist_le_Hausdorff_edist_of_mem xu) _
    ... = Hausdorff_edist s t + Hausdorff_edist t u : by simp [Hausdorff_edist_comm, add_comm]
end

/-- Two sets are at zero Hausdorff edistance if and only if they have the same closure -/
lemma Hausdorff_edist_zero_iff_closure_eq_closure :
  Hausdorff_edist s t = 0 ↔ closure s = closure t :=
calc Hausdorff_edist s t = 0 ↔ s ⊆ closure t ∧ t ⊆ closure s :
  by simp only [Hausdorff_edist_def, ennreal.sup_eq_zero, ennreal.supr_eq_zero,
    ← mem_closure_iff_inf_edist_zero, subset_def]
... ↔ closure s = closure t :
  ⟨λ h, subset.antisymm (closure_minimal h.1 is_closed_closure)
     (closure_minimal h.2 is_closed_closure),
   λ h, ⟨h ▸ subset_closure, h.symm ▸ subset_closure⟩⟩

/-- The Hausdorff edistance between a set and its closure vanishes -/
@[simp, priority 1100]
lemma Hausdorff_edist_self_closure : Hausdorff_edist s (closure s) = 0 :=
by rw [Hausdorff_edist_zero_iff_closure_eq_closure, closure_closure]

/-- Replacing a set by its closure does not change the Hausdorff edistance. -/
@[simp] lemma Hausdorff_edist_closure₁ : Hausdorff_edist (closure s) t = Hausdorff_edist s t :=
begin
  refine le_antisymm _ _,
  { calc  _ ≤ Hausdorff_edist (closure s) s + Hausdorff_edist s t : Hausdorff_edist_triangle
    ... = Hausdorff_edist s t : by simp [Hausdorff_edist_comm] },
  { calc _ ≤ Hausdorff_edist s (closure s) + Hausdorff_edist (closure s) t :
      Hausdorff_edist_triangle
    ... = Hausdorff_edist (closure s) t : by simp }
end

/-- Replacing a set by its closure does not change the Hausdorff edistance. -/
@[simp] lemma Hausdorff_edist_closure₂ : Hausdorff_edist s (closure t) = Hausdorff_edist s t :=
by simp [@Hausdorff_edist_comm _ _ s _]

/-- The Hausdorff edistance between sets or their closures is the same -/
@[simp] lemma Hausdorff_edist_closure :
  Hausdorff_edist (closure s) (closure t) = Hausdorff_edist s t :=
by simp

/-- Two closed sets are at zero Hausdorff edistance if and only if they coincide -/
lemma Hausdorff_edist_zero_iff_eq_of_closed (hs : is_closed s) (ht : is_closed t) :
  Hausdorff_edist s t = 0 ↔ s = t :=
by rw [Hausdorff_edist_zero_iff_closure_eq_closure, hs.closure_eq, ht.closure_eq]

/-- The Haudorff edistance to the empty set is infinite -/
lemma Hausdorff_edist_empty (ne : s.nonempty) : Hausdorff_edist s ∅ = ∞ :=
begin
  rcases ne with ⟨x, xs⟩,
  have : inf_edist x ∅ ≤ Hausdorff_edist s ∅ := inf_edist_le_Hausdorff_edist_of_mem xs,
  simpa using this,
end

/-- If a set is at finite Hausdorff edistance of a nonempty set, it is nonempty -/
lemma nonempty_of_Hausdorff_edist_ne_top (hs : s.nonempty) (fin : Hausdorff_edist s t ≠ ⊤) :
  t.nonempty :=
t.eq_empty_or_nonempty.elim (λ ht, (fin $ ht.symm ▸ Hausdorff_edist_empty hs).elim) id

lemma empty_or_nonempty_of_Hausdorff_edist_ne_top (fin : Hausdorff_edist s t ≠ ⊤) :
  s = ∅ ∧ t = ∅ ∨ s.nonempty ∧ t.nonempty :=
begin
  cases s.eq_empty_or_nonempty with hs hs,
  { cases t.eq_empty_or_nonempty with ht ht,
    { exact or.inl ⟨hs, ht⟩ },
    { rw Hausdorff_edist_comm at fin,
      exact or.inr ⟨nonempty_of_Hausdorff_edist_ne_top ht fin, ht⟩ } },
  { exact or.inr ⟨hs, nonempty_of_Hausdorff_edist_ne_top hs fin⟩ }
end

end Hausdorff_edist -- section
end emetric --namespace

/-! Now, we turn to the same notions in metric spaces. To avoid the difficulties related to
`Inf` and `Sup` on `ℝ` (which is only conditionally complete), we use the notions in `ℝ≥0∞`
formulated in terms of the edistance, and coerce them to `ℝ`.
Then their properties follow readily from the corresponding properties in `ℝ≥0∞`,
modulo some tedious rewriting of inequalities from one to the other. -/

namespace metric
section
variables {α : Type u} {β : Type v} [pseudo_metric_space α] [pseudo_metric_space β]
  {s t u : set α} {x y : α} {Φ : α → β}
open emetric

/-! ### Distance of a point to a set as a function into `ℝ`. -/

/-- The minimal distance of a point to a set -/
def inf_dist (x : α) (s : set α) : ℝ := ennreal.to_real (inf_edist x s)

/-- the minimal distance is always nonnegative -/
lemma inf_dist_nonneg : 0 ≤ inf_dist x s := by simp [inf_dist]

/-- the minimal distance to the empty set is 0 (if you want to have the more reasonable
value ∞ instead, use `inf_edist`, which takes values in ℝ≥0∞) -/
@[simp] lemma inf_dist_empty : inf_dist x ∅ = 0 :=
by simp [inf_dist]

/-- In a metric space, the minimal edistance to a nonempty set is finite -/
lemma inf_edist_ne_top (h : s.nonempty) : inf_edist x s ≠ ⊤ :=
begin
  rcases h with ⟨y, hy⟩,
  apply lt_top_iff_ne_top.1,
  calc inf_edist x s ≤ edist x y : inf_edist_le_edist_of_mem hy
       ... < ⊤ : lt_top_iff_ne_top.2 (edist_ne_top _ _)
end

/-- The minimal distance of a point to a set containing it vanishes -/
lemma inf_dist_zero_of_mem (h : x ∈ s) : inf_dist x s = 0 :=
by simp [inf_edist_zero_of_mem h, inf_dist]

/-- The minimal distance to a singleton is the distance to the unique point in this singleton -/
@[simp] lemma inf_dist_singleton : inf_dist x {y} = dist x y :=
by simp [inf_dist, inf_edist, dist_edist]

/-- The minimal distance to a set is bounded by the distance to any point in this set -/
lemma inf_dist_le_dist_of_mem (h : y ∈ s) : inf_dist x s ≤ dist x y :=
begin
  rw [dist_edist, inf_dist,
    ennreal.to_real_le_to_real (inf_edist_ne_top ⟨_, h⟩) (edist_ne_top _ _)],
  exact inf_edist_le_edist_of_mem h
end

/-- The minimal distance is monotonous with respect to inclusion -/
lemma inf_dist_le_inf_dist_of_subset (h : s ⊆ t) (hs : s.nonempty) :
  inf_dist x t ≤ inf_dist x s :=
begin
  have ht : t.nonempty := hs.mono h,
  rw [inf_dist, inf_dist, ennreal.to_real_le_to_real (inf_edist_ne_top ht) (inf_edist_ne_top hs)],
  exact inf_edist_le_inf_edist_of_subset h
end

/-- If the minimal distance to a set is `<r`, there exists a point in this set at distance `<r` -/
lemma exists_dist_lt_of_inf_dist_lt {r : real} (h : inf_dist x s < r) (hs : s.nonempty) :
  ∃y∈s, dist x y < r :=
begin
  have rpos : 0 < r := lt_of_le_of_lt inf_dist_nonneg h,
  have : inf_edist x s < ennreal.of_real r,
  { rwa [inf_dist, ← ennreal.to_real_of_real (le_of_lt rpos),
      ennreal.to_real_lt_to_real (inf_edist_ne_top hs)] at h,
    simp },
  rcases exists_edist_lt_of_inf_edist_lt this with ⟨y, ys, hy⟩,
  rw [edist_dist, ennreal.of_real_lt_of_real_iff rpos] at hy,
  exact ⟨y, ys, hy⟩,
end

/-- The minimal distance from `x` to `s` is bounded by the distance from `y` to `s`, modulo
the distance between `x` and `y` -/
lemma inf_dist_le_inf_dist_add_dist : inf_dist x s ≤ inf_dist y s + dist x y :=
begin
  cases s.eq_empty_or_nonempty with hs hs,
  { by simp [hs, dist_nonneg] },
  { rw [inf_dist, inf_dist, dist_edist,
        ← ennreal.to_real_add (inf_edist_ne_top hs) (edist_ne_top _ _),
        ennreal.to_real_le_to_real (inf_edist_ne_top hs)],
    { apply inf_edist_le_inf_edist_add_edist },
    { simp [ennreal.add_eq_top, inf_edist_ne_top hs, edist_ne_top] }}
end

lemma disjoint_closed_ball_of_lt_inf_dist {r : ℝ} (h : r < inf_dist x s) :
  disjoint (closed_ball x r) s :=
begin
  rw disjoint_left,
  assume y hy h'y,
  apply lt_irrefl (inf_dist x s),
  calc inf_dist x s ≤ dist x y : inf_dist_le_dist_of_mem h'y
  ... ≤ r : by rwa [mem_closed_ball, dist_comm] at hy
  ... < inf_dist x s : h
end

variable (s)

/-- The minimal distance to a set is Lipschitz in point with constant 1 -/
lemma lipschitz_inf_dist_pt : lipschitz_with 1 (λx, inf_dist x s) :=
lipschitz_with.of_le_add $ λ x y, inf_dist_le_inf_dist_add_dist

/-- The minimal distance to a set is uniformly continuous in point -/

/-- The minimal distance to a set is continuous in point -/
@[continuity]
lemma continuous_inf_dist_pt : continuous (λx, inf_dist x s) :=
(uniform_continuous_inf_dist_pt s).continuous

variable {s}

/-- The minimal distance to a set and its closure coincide -/
lemma inf_dist_eq_closure : inf_dist x (closure s) = inf_dist x s :=
by simp [inf_dist, inf_edist_closure]

/-- A point belongs to the closure of `s` iff its infimum distance to this set vanishes -/
lemma mem_closure_iff_inf_dist_zero (h : s.nonempty) : x ∈ closure s ↔ inf_dist x s = 0 :=
by simp [mem_closure_iff_inf_edist_zero, inf_dist, ennreal.to_real_eq_zero_iff, inf_edist_ne_top h]

/-- Given a closed set `s`, a point belongs to `s` iff its infimum distance to this set vanishes -/
lemma _root_.is_closed.mem_iff_inf_dist_zero (h : is_closed s) (hs : s.nonempty) :
  x ∈ s ↔ inf_dist x s = 0 :=
begin
  have := @mem_closure_iff_inf_dist_zero _ _ s x hs,
  rwa h.closure_eq at this
end

/-- Given a closed set `s`, a point belongs to `s` iff its infimum distance to this set vanishes -/
lemma _root_.is_closed.not_mem_iff_inf_dist_pos (h : is_closed s) (hs : s.nonempty) :
  x ∉ s ↔ 0 < inf_dist x s :=
begin
  rw ← not_iff_not,
  push_neg,
  simp [h.mem_iff_inf_dist_zero hs, le_antisymm_iff, inf_dist_nonneg],
end

/-- The infimum distance is invariant under isometries -/
lemma inf_dist_image (hΦ : isometry Φ) :
  inf_dist (Φ x) (Φ '' t) = inf_dist x t :=
by simp [inf_dist, inf_edist_image hΦ]

/-! ### Distance of a point to a set as a function into `ℝ≥0`. -/

/-- The minimal distance of a point to a set as a `ℝ≥0` -/
def inf_nndist (x : α) (s : set α) : ℝ≥0 := ennreal.to_nnreal (inf_edist x s)
@[simp] lemma coe_inf_nndist : (inf_nndist x s : ℝ) = inf_dist x s := rfl

/-- The minimal distance to a set (as `ℝ≥0`) is Lipschitz in point with constant 1 -/
lemma lipschitz_inf_nndist_pt (s : set α) : lipschitz_with 1 (λx, inf_nndist x s) :=
lipschitz_with.of_le_add $ λ x y, inf_dist_le_inf_dist_add_dist

/-- The minimal distance to a set (as `ℝ≥0`) is uniformly continuous in point -/
lemma uniform_continuous_inf_nndist_pt (s : set α) :
  uniform_continuous (λx, inf_nndist x s) :=
(lipschitz_inf_nndist_pt s).uniform_continuous

/-- The minimal distance to a set (as `ℝ≥0`) is continuous in point -/
lemma continuous_inf_nndist_pt (s : set α) : continuous (λx, inf_nndist x s) :=
(uniform_continuous_inf_nndist_pt s).continuous

/-! ### The Hausdorff distance as a function into `ℝ`. -/

/-- The Hausdorff distance between two sets is the smallest nonnegative `r` such that each set is
included in the `r`-neighborhood of the other. If there is no such `r`, it is defined to
be `0`, arbitrarily -/
def Hausdorff_dist (s t : set α) : ℝ := ennreal.to_real (Hausdorff_edist s t)

/-- The Hausdorff distance is nonnegative -/
lemma Hausdorff_dist_nonneg : 0 ≤ Hausdorff_dist s t :=
by simp [Hausdorff_dist]

/-- If two sets are nonempty and bounded in a metric space, they are at finite Hausdorff
edistance. -/
lemma Hausdorff_edist_ne_top_of_nonempty_of_bounded (hs : s.nonempty) (ht : t.nonempty)
  (bs : bounded s) (bt : bounded t) : Hausdorff_edist s t ≠ ⊤ :=
begin
  rcases hs with ⟨cs, hcs⟩,
  rcases ht with ⟨ct, hct⟩,
  rcases (bounded_iff_subset_ball ct).1 bs with ⟨rs, hrs⟩,
  rcases (bounded_iff_subset_ball cs).1 bt with ⟨rt, hrt⟩,
  have : Hausdorff_edist s t ≤ ennreal.of_real (max rs rt),
  { apply Hausdorff_edist_le_of_mem_edist,
    { assume x xs,
      existsi [ct, hct],
      have : dist x ct ≤ max rs rt := le_trans (hrs xs) (le_max_left _ _),
      rwa [edist_dist, ennreal.of_real_le_of_real_iff],
      exact le_trans dist_nonneg this },
    { assume x xt,
      existsi [cs, hcs],
      have : dist x cs ≤ max rs rt := le_trans (hrt xt) (le_max_right _ _),
      rwa [edist_dist, ennreal.of_real_le_of_real_iff],
      exact le_trans dist_nonneg this }},
  exact ne_top_of_le_ne_top ennreal.of_real_ne_top this
end

/-- The Hausdorff distance between a set and itself is zero -/
@[simp] lemma Hausdorff_dist_self_zero : Hausdorff_dist s s = 0 :=
by simp [Hausdorff_dist]

/-- The Hausdorff distance from `s` to `t` and from `t` to `s` coincide -/
lemma Hausdorff_dist_comm : Hausdorff_dist s t = Hausdorff_dist t s :=
by simp [Hausdorff_dist, Hausdorff_edist_comm]

/-- The Hausdorff distance to the empty set vanishes (if you want to have the more reasonable
value ∞ instead, use `Hausdorff_edist`, which takes values in ℝ≥0∞) -/
@[simp] lemma Hausdorff_dist_empty : Hausdorff_dist s ∅ = 0 :=
begin
  cases s.eq_empty_or_nonempty with h h,
  { simp [h] },
  { simp [Hausdorff_dist, Hausdorff_edist_empty h] }
end

/-- The Hausdorff distance to the empty set vanishes (if you want to have the more reasonable
value ∞ instead, use `Hausdorff_edist`, which takes values in ℝ≥0∞) -/
@[simp] lemma Hausdorff_dist_empty' : Hausdorff_dist ∅ s = 0 :=
by simp [Hausdorff_dist_comm]

/-- Bounding the Hausdorff distance by bounding the distance of any point
in each set to the other set -/
lemma Hausdorff_dist_le_of_inf_dist {r : ℝ} (hr : 0 ≤ r)
  (H1 : ∀x ∈ s, inf_dist x t ≤ r) (H2 : ∀x ∈ t, inf_dist x s ≤ r) :
  Hausdorff_dist s t ≤ r :=
begin
  by_cases h1 : Hausdorff_edist s t = ⊤,
    by rwa [Hausdorff_dist, h1, ennreal.top_to_real],
  cases s.eq_empty_or_nonempty with hs hs,
    by rwa [hs, Hausdorff_dist_empty'],
  cases t.eq_empty_or_nonempty with ht ht,
    by rwa [ht, Hausdorff_dist_empty],
  have : Hausdorff_edist s t ≤ ennreal.of_real r,
  { apply Hausdorff_edist_le_of_inf_edist _ _,
    { assume x hx,
      have I := H1 x hx,
      rwa [inf_dist, ← ennreal.to_real_of_real hr,
           ennreal.to_real_le_to_real (inf_edist_ne_top ht) ennreal.of_real_ne_top] at I },
    { assume x hx,
      have I := H2 x hx,
      rwa [inf_dist, ← ennreal.to_real_of_real hr,
           ennreal.to_real_le_to_real (inf_edist_ne_top hs) ennreal.of_real_ne_top] at I }},
  rwa [Hausdorff_dist, ← ennreal.to_real_of_real hr,
       ennreal.to_real_le_to_real h1 ennreal.of_real_ne_top]
end

/-- Bounding the Hausdorff distance by exhibiting, for any point in each set,
another point in the other set at controlled distance -/
lemma Hausdorff_dist_le_of_mem_dist {r : ℝ} (hr : 0 ≤ r)
  (H1 : ∀x ∈ s, ∃y ∈ t, dist x y ≤ r) (H2 : ∀x ∈ t, ∃y ∈ s, dist x y ≤ r) :
  Hausdorff_dist s t ≤ r :=
begin
  apply Hausdorff_dist_le_of_inf_dist hr,
  { assume x xs,
    rcases H1 x xs with ⟨y, yt, hy⟩,
    exact le_trans (inf_dist_le_dist_of_mem yt) hy },
  { assume x xt,
    rcases H2 x xt with ⟨y, ys, hy⟩,
    exact le_trans (inf_dist_le_dist_of_mem ys) hy }
end

/-- The Hausdorff distance is controlled by the diameter of the union -/
lemma Hausdorff_dist_le_diam (hs : s.nonempty) (bs : bounded s) (ht : t.nonempty) (bt : bounded t) :
  Hausdorff_dist s t ≤ diam (s ∪ t) :=
begin
  rcases hs with ⟨x, xs⟩,
  rcases ht with ⟨y, yt⟩,
  refine Hausdorff_dist_le_of_mem_dist diam_nonneg _ _,
  { exact  λz hz, ⟨y, yt, dist_le_diam_of_mem (bounded_union.2 ⟨bs, bt⟩)
      (subset_union_left _ _ hz) (subset_union_right _ _ yt)⟩ },
  { exact λz hz, ⟨x, xs, dist_le_diam_of_mem (bounded_union.2 ⟨bs, bt⟩)
      (subset_union_right _ _ hz) (subset_union_left _ _ xs)⟩ }
end

/-- The distance to a set is controlled by the Hausdorff distance -/
lemma inf_dist_le_Hausdorff_dist_of_mem (hx : x ∈ s) (fin : Hausdorff_edist s t ≠ ⊤) :
  inf_dist x t ≤ Hausdorff_dist s t :=
begin
  have ht : t.nonempty := nonempty_of_Hausdorff_edist_ne_top ⟨x, hx⟩ fin,
  rw [Hausdorff_dist, inf_dist, ennreal.to_real_le_to_real (inf_edist_ne_top ht) fin],
  exact inf_edist_le_Hausdorff_edist_of_mem hx
end

/-- If the Hausdorff distance is `<r`, then any point in one of the sets is at distance
`<r` of a point in the other set -/
lemma exists_dist_lt_of_Hausdorff_dist_lt {r : ℝ} (h : x ∈ s) (H : Hausdorff_dist s t < r)
  (fin : Hausdorff_edist s t ≠ ⊤) : ∃y∈t, dist x y < r :=
begin
  have r0 : 0 < r := lt_of_le_of_lt (Hausdorff_dist_nonneg) H,
  have : Hausdorff_edist s t < ennreal.of_real r,
    by rwa [Hausdorff_dist, ← ennreal.to_real_of_real (le_of_lt r0),
            ennreal.to_real_lt_to_real fin (ennreal.of_real_ne_top)] at H,
  rcases exists_edist_lt_of_Hausdorff_edist_lt h this with ⟨y, hy, yr⟩,
  rw [edist_dist, ennreal.of_real_lt_of_real_iff r0] at yr,
  exact ⟨y, hy, yr⟩
end

/-- If the Hausdorff distance is `<r`, then any point in one of the sets is at distance
`<r` of a point in the other set -/
lemma exists_dist_lt_of_Hausdorff_dist_lt' {r : ℝ} (h : y ∈ t) (H : Hausdorff_dist s t < r)
  (fin : Hausdorff_edist s t ≠ ⊤) : ∃x∈s, dist x y < r :=
begin
  rw Hausdorff_dist_comm at H,
  rw Hausdorff_edist_comm at fin,
  simpa [dist_comm] using exists_dist_lt_of_Hausdorff_dist_lt h H fin
end

/-- The infimum distance to `s` and `t` are the same, up to the Hausdorff distance
between `s` and `t` -/
lemma inf_dist_le_inf_dist_add_Hausdorff_dist (fin : Hausdorff_edist s t ≠ ⊤) :
  inf_dist x t ≤ inf_dist x s + Hausdorff_dist s t :=
begin
  rcases empty_or_nonempty_of_Hausdorff_edist_ne_top fin with ⟨hs,ht⟩|⟨hs,ht⟩,
  { simp only [hs, ht, Hausdorff_dist_empty, inf_dist_empty, zero_add] },
  rw [inf_dist, inf_dist, Hausdorff_dist, ← ennreal.to_real_add (inf_edist_ne_top hs) fin,
      ennreal.to_real_le_to_real (inf_edist_ne_top ht)],
  { exact inf_edist_le_inf_edist_add_Hausdorff_edist },
  { exact ennreal.add_ne_top.2 ⟨inf_edist_ne_top hs, fin⟩ }
end

/-- The Hausdorff distance is invariant under isometries -/
lemma Hausdorff_dist_image (h : isometry Φ) :
  Hausdorff_dist (Φ '' s) (Φ '' t) = Hausdorff_dist s t :=
by simp [Hausdorff_dist, Hausdorff_edist_image h]

/-- The Hausdorff distance satisfies the triangular inequality -/
lemma Hausdorff_dist_triangle (fin : Hausdorff_edist s t ≠ ⊤) :
  Hausdorff_dist s u ≤ Hausdorff_dist s t + Hausdorff_dist t u :=
begin
  by_cases Hausdorff_edist s u = ⊤,
  { calc Hausdorff_dist s u = 0 + 0 : by simp [Hausdorff_dist, h]
         ... ≤ Hausdorff_dist s t + Hausdorff_dist t u :
           add_le_add (Hausdorff_dist_nonneg) (Hausdorff_dist_nonneg) },
  { have Dtu : Hausdorff_edist t u < ⊤ := calc
      Hausdorff_edist t u ≤ Hausdorff_edist t s + Hausdorff_edist s u : Hausdorff_edist_triangle
      ... = Hausdorff_edist s t + Hausdorff_edist s u : by simp [Hausdorff_edist_comm]
      ... < ⊤ : by simp [lt_top_iff_ne_top, *],
    rw [Hausdorff_dist, Hausdorff_dist, Hausdorff_dist,
        ← ennreal.to_real_add fin Dtu.ne, ennreal.to_real_le_to_real h],
    { exact Hausdorff_edist_triangle },
    { simp [ennreal.add_eq_top, lt_top_iff_ne_top.1 Dtu, fin] }}
end

/-- The Hausdorff distance satisfies the triangular inequality -/
lemma Hausdorff_dist_triangle' (fin : Hausdorff_edist t u ≠ ⊤) :
  Hausdorff_dist s u ≤ Hausdorff_dist s t + Hausdorff_dist t u :=
begin
  rw Hausdorff_edist_comm at fin,
  have I : Hausdorff_dist u s ≤ Hausdorff_dist u t + Hausdorff_dist t s :=
    Hausdorff_dist_triangle fin,
  simpa [add_comm, Hausdorff_dist_comm] using I
end

/-- The Hausdorff distance between a set and its closure vanish -/
@[simp, priority 1100]
lemma Hausdorff_dist_self_closure : Hausdorff_dist s (closure s) = 0 :=
by simp [Hausdorff_dist]

/-- Replacing a set by its closure does not change the Hausdorff distance. -/
@[simp] lemma Hausdorff_dist_closure₁ : Hausdorff_dist (closure s) t = Hausdorff_dist s t :=
by simp [Hausdorff_dist]

/-- Replacing a set by its closure does not change the Hausdorff distance. -/
@[simp] lemma Hausdorff_dist_closure₂ : Hausdorff_dist s (closure t) = Hausdorff_dist s t :=
by simp [Hausdorff_dist]

/-- The Hausdorff distance between two sets and their closures coincide -/
@[simp] lemma Hausdorff_dist_closure :
  Hausdorff_dist (closure s) (closure t) = Hausdorff_dist s t :=
by simp [Hausdorff_dist]

/-- Two sets are at zero Hausdorff distance if and only if they have the same closures -/
lemma Hausdorff_dist_zero_iff_closure_eq_closure (fin : Hausdorff_edist s t ≠ ⊤) :
  Hausdorff_dist s t = 0 ↔ closure s = closure t :=
by simp [Hausdorff_edist_zero_iff_closure_eq_closure.symm, Hausdorff_dist,
         ennreal.to_real_eq_zero_iff, fin]

/-- Two closed sets are at zero Hausdorff distance if and only if they coincide -/
lemma _root_.is_closed.Hausdorff_dist_zero_iff_eq (hs : is_closed s) (ht : is_closed t)
  (fin : Hausdorff_edist s t ≠ ⊤) : Hausdorff_dist s t = 0 ↔ s = t :=
by simp [(Hausdorff_edist_zero_iff_eq_of_closed hs ht).symm, Hausdorff_dist,
         ennreal.to_real_eq_zero_iff, fin]

end --section

section thickening

variables {α : Type u} [pseudo_emetric_space α]

open emetric

/-- The (open) `δ`-thickening `thickening δ E` of a subset `E` in a pseudo emetric space consists
of those points that are at distance less than `δ` from some point of `E`. -/
def thickening (δ : ℝ) (E : set α) : set α := {x : α | inf_edist x E < ennreal.of_real δ}

/-- The (open) thickening equals the preimage of an open interval under `inf_edist`. -/
lemma thickening_eq_preimage_inf_edist (δ : ℝ) (E : set α) :
  thickening δ E = (λ x, inf_edist x E) ⁻¹' (Iio (ennreal.of_real δ)) := rfl

/-- The (open) thickening is an open set. -/
lemma is_open_thickening {δ : ℝ} {E : set α} : is_open (thickening δ E) :=
continuous.is_open_preimage continuous_inf_edist _ is_open_Iio

/-- The (open) thickening of the empty set is empty. -/
@[simp] lemma thickening_empty (δ : ℝ) : thickening δ (∅ : set α) = ∅ :=
by simp only [thickening, set_of_false, inf_edist_empty, not_top_lt]

/-- The (open) thickening `thickening δ E` of a fixed subset `E` is an increasing function of the
thickening radius `δ`. -/
lemma thickening_mono {δ₁ δ₂ : ℝ} (hle : δ₁ ≤ δ₂) (E : set α) :
  thickening δ₁ E ⊆ thickening δ₂ E :=
preimage_mono (Iio_subset_Iio (ennreal.of_real_le_of_real hle))

/-- The (open) thickening `thickening δ E` with a fixed thickening radius `δ` is
an increasing function of the subset `E`. -/
lemma thickening_subset_of_subset (δ : ℝ) {E₁ E₂ : set α} (h : E₁ ⊆ E₂) :
  thickening δ E₁ ⊆ thickening δ E₂ :=
λ _ hx, lt_of_le_of_lt (inf_edist_le_inf_edist_of_subset h) hx

lemma mem_thickening_iff_exists_edist_lt {δ : ℝ} (E : set α) (x : α) :
  x ∈ thickening δ E ↔ (∃ z ∈ E, edist x z < ennreal.of_real δ) :=
begin
  simp only [exists_prop, mem_set_of_eq],
  split,
  { intros h,
    rcases (exists_edist_lt_of_inf_edist_lt h) with ⟨z, ⟨hzE, hxz⟩⟩,
    exact ⟨z, hzE, hxz⟩, },
  { rintros ⟨z, ⟨hzE, hxz⟩⟩,
    exact lt_of_le_of_lt (@inf_edist_le_edist_of_mem _ _ x _ _ hzE) hxz, },
end

variables {X : Type u} [metric_space X]

/-- A point in a metric space belongs to the (open) `δ`-thickening of a subset `E` if and only if
it is at distance less than `δ` from some point of `E`. -/
lemma mem_thickening_iff {δ : ℝ} (E : set X) (x : X) :
  x ∈ thickening δ E ↔ (∃ z ∈ E, dist x z < δ) :=
begin
  have key_iff : ∀ (z : X), edist x z < ennreal.of_real δ ↔ dist x z < δ,
  { intros z,
    rw dist_edist,
    have d_lt_top : edist x z < ∞, by simp only [edist_dist, ennreal.of_real_lt_top],
    have key := (@ennreal.of_real_lt_of_real_iff_of_nonneg
                ((edist x z).to_real) δ (ennreal.to_real_nonneg)),
    rwa ennreal.of_real_to_real d_lt_top.ne at key, },
  simp_rw [mem_thickening_iff_exists_edist_lt, key_iff],
end

/-- The (open) `δ`-thickening `thickening δ E` of a subset `E` in a metric space equals the
union of balls of radius `δ` centered at points of `E`. -/
lemma thickening_eq_bUnion_ball {δ : ℝ} {E : set X} :
  thickening δ E = ⋃ x ∈ E, ball x δ :=
by { ext x, rw mem_bUnion_iff, exact mem_thickening_iff E x, }

end thickening --section

section cthickening

variables {α : Type*} [pseudo_emetric_space α]

open emetric

/-- The closed `δ`-thickening `cthickening δ E` of a subset `E` in a pseudo emetric space consists
of those points that are at infimum distance at most `δ` from `E`. -/
def cthickening (δ : ℝ) (E : set α) : set α := {x : α | inf_edist x E ≤ ennreal.of_real δ}

lemma cthickening_eq_preimage_inf_edist (δ : ℝ) (E : set α) :
  cthickening δ E = (λ x, inf_edist x E) ⁻¹' (Iic (ennreal.of_real δ)) := rfl

lemma is_closed_cthickening {δ : ℝ} {E : set α} : is_closed (cthickening δ E) :=
is_closed.preimage continuous_inf_edist is_closed_Iic

@[simp] lemma cthickening_empty (δ : ℝ) : cthickening δ (∅ : set α) = ∅ :=
by simp only [cthickening, ennreal.of_real_ne_top, set_of_false, inf_edist_empty, top_le_iff]

@[simp] lemma cthickening_zero (E : set α) : cthickening 0 E = closure E :=
by { ext x, simp [mem_closure_iff_inf_edist_zero, cthickening], }

lemma cthickening_mono {δ₁ δ₂ : ℝ} (hle : δ₁ ≤ δ₂) (E : set α) :
  cthickening δ₁ E ⊆ cthickening δ₂ E :=
preimage_mono (Iic_subset_Iic.mpr (ennreal.of_real_le_of_real hle))

lemma closure_subset_cthickening {δ : ℝ} (δ_nn : 0 ≤ δ) (E : set α) :
  closure E ⊆ cthickening δ E :=
by { rw ← cthickening_zero, exact cthickening_mono δ_nn E, }

lemma cthickening_subset_of_subset (δ : ℝ) {E₁ E₂ : set α} (h : E₁ ⊆ E₂) :
  cthickening δ E₁ ⊆ cthickening δ E₂ :=
λ _ hx, le_trans (inf_edist_le_inf_edist_of_subset h) hx

lemma cthickening_subset_thickening {δ₁ : ℝ≥0} {δ₂ : ℝ} (hlt : (δ₁ : ℝ) < δ₂) (E : set α) :
  cthickening δ₁ E ⊆ thickening δ₂ E :=
λ _ hx, lt_of_le_of_lt hx ((ennreal.of_real_lt_of_real_iff (lt_of_le_of_lt δ₁.prop hlt)).mpr hlt)

lemma cthickening_subset_thickening' {δ₁ δ₂ : ℝ} (δ₂_pos : 0 < δ₂) (hlt : δ₁ < δ₂) (E : set α) :
  cthickening δ₁ E ⊆ thickening δ₂ E :=
λ _ hx, lt_of_le_of_lt hx ((ennreal.of_real_lt_of_real_iff δ₂_pos).mpr hlt)

lemma thickening_subset_cthickening (δ : ℝ) (E : set α) :
  thickening δ E ⊆ cthickening δ E :=
by { intros x hx, rw [thickening, mem_set_of_eq] at hx, exact hx.le, }

lemma thickening_subset_cthickening_of_le {δ₁ δ₂ : ℝ} (hle : δ₁ ≤ δ₂) (E : set α) :
  thickening δ₁ E ⊆ cthickening δ₂ E :=
(thickening_subset_cthickening δ₁ E).trans (cthickening_mono hle E)

lemma cthickening_eq_Inter_cthickening {δ : ℝ} {E : set α} (δ_nn : 0 ≤ δ) :
  cthickening δ E = ⋂ (ε : ℝ) (h : δ < ε), cthickening ε E :=
begin
  apply le_antisymm,
  { exact subset_bInter (λ _ hε, cthickening_mono (has_lt.lt.le hε) E) },
  { unfold thickening cthickening,
    intros x hx,
    simp only [mem_Inter, mem_set_of_eq] at *,
    have inf_edist_lt_top : inf_edist x E < ∞,
    { exact lt_of_le_of_lt (hx (δ + 1) (by linarith)) ennreal.of_real_lt_top, },
    rw ← ennreal.of_real_to_real inf_edist_lt_top.ne,
    apply ennreal.of_real_le_of_real,
    apply le_of_forall_pos_le_add,
    intros η η_pos,
    have sum_nn : 0 ≤ δ + η := by linarith,
    apply (ennreal.of_real_le_of_real_iff sum_nn).mp,
    have key := hx (δ + η) (by linarith),
    rwa ← ennreal.of_real_to_real inf_edist_lt_top.ne at key, },
end

lemma closure_eq_Inter_cthickening {E : set α} :
  closure E = ⋂ (δ : ℝ) (h : 0 < δ), cthickening δ E :=
by { rw ← cthickening_zero, exact cthickening_eq_Inter_cthickening rfl.ge, }

end cthickening --section

end metric --namespace


/-
Copyright (c) 2018 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad
-/
import order.complete_lattice
import order.galois_connection

/-!
# Relations

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

This file defines bundled relations. A relation between `α` and `β` is a function `α → β → Prop`.
Relations are also known as set-valued functions, or partial multifunctions.

## Main declarations

* `rel α β`: Relation between `α` and `β`.
* `rel.inv`: `r.inv` is the `rel β α` obtained by swapping the arguments of `r`.
* `rel.dom`: Domain of a relation. `x ∈ r.dom` iff there exists `y` such that `r x y`.
* `rel.codom`: Codomain, aka range, of a relation. `y ∈ r.codom` iff there exists `x` such that
  `r x y`.
* `rel.comp`: Relation composition. Note that the arguments order follows the `category_theory/`
  one, so `r.comp s x z ↔ ∃ y, r x y ∧ s y z`.
* `rel.image`: Image of a set under a relation. `r.image s` is the set of `f x` over all `x ∈ s`.
* `rel.preimage`: Preimage of a set under a relation. Note that `r.preimage = r.inv.image`.
* `rel.core`: Core of a set. For `s : set β`, `r.core s` is the set of `x : α` such that all `y`
  related to `x` are in `s`.
* `rel.restrict_domain`: Domain-restriction of a relation to a subtype.
* `function.graph`: Graph of a function as a relation.
-/

variables {α β γ : Type*}

/-- A relation on `α` and `β`, aka a set-valued function, aka a partial multifunction -/
@[derive complete_lattice, derive inhabited]
def rel (α β : Type*) := α → β → Prop

namespace rel

variables {δ : Type*} (r : rel α β)

/-- The inverse relation : `r.inv x y ↔ r y x`. Note that this is *not* a groupoid inverse. -/
def inv : rel β α := flip r

lemma inv_def (x : α) (y : β) : r.inv y x ↔ r x y := iff.rfl

lemma inv_inv : inv (inv r) = r := by { ext x y, reflexivity }

/-- Domain of a relation -/
def dom := {x | ∃ y, r x y}

lemma dom_mono {r s : rel α β} (h : r ≤ s) : dom r ⊆ dom s :=
λ a ⟨b, hx⟩, ⟨b, h a b hx⟩

/-- Codomain aka range of a relation -/
def codom := {y | ∃ x, r x y}

lemma codom_inv : r.inv.codom = r.dom := by { ext x y, reflexivity }

lemma dom_inv : r.inv.dom = r.codom := by { ext x y, reflexivity}

/-- Composition of relation; note that it follows the `category_theory/` order of arguments. -/
def comp (r : rel α β) (s : rel β γ) : rel α γ :=
λ x z, ∃ y, r x y ∧ s y z

local infixr (name := rel.comp) ` ∘ ` := rel.comp

lemma comp_assoc (r : rel α β) (s : rel β γ) (t : rel γ δ) :
  (r ∘ s) ∘ t = r ∘ s ∘ t :=
begin
  unfold comp, ext x w, split,
  { rintros ⟨z, ⟨y, rxy, syz⟩, tzw⟩, exact ⟨y, rxy, z, syz, tzw⟩ },
  rintros ⟨y, rxy, z, syz, tzw⟩, exact ⟨z, ⟨y, rxy, syz⟩, tzw⟩
end

@[simp]
lemma comp_right_id (r : rel α β) : r ∘ @eq β = r :=
by { unfold comp, ext y, simp }

@[simp]
lemma comp_left_id (r : rel α β) : @eq α ∘ r = r :=
by { unfold comp, ext x, simp }

lemma inv_id : inv (@eq α) = @eq α :=
by { ext x y, split; apply eq.symm }

lemma inv_comp (r : rel α β) (s : rel β γ) : inv (r ∘ s) = inv s ∘ inv r :=
by { ext x z, simp [comp, inv, flip, and.comm] }

/-- Image of a set under a relation -/
def image (s : set α) : set β := {y | ∃ x ∈ s, r x y}

lemma mem_image (y : β) (s : set α) : y ∈ image r s ↔ ∃ x ∈ s, r x y :=
iff.rfl

lemma image_subset : ((⊆) ⇒ (⊆)) r.image r.image :=
λ s t h y ⟨x, xs, rxy⟩, ⟨x, h xs, rxy⟩

lemma image_mono : monotone r.image := r.image_subset

lemma image_inter (s t : set α) : r.image (s ∩ t) ⊆ r.image s ∩ r.image t :=
r.image_mono.map_inf_le s t

lemma image_union (s t : set α) : r.image (s ∪ t) = r.image s ∪ r.image t :=
le_antisymm
  (λ y ⟨x, xst, rxy⟩, xst.elim (λ xs, or.inl ⟨x, ⟨xs, rxy⟩⟩) (λ xt, or.inr ⟨x, ⟨xt, rxy⟩⟩))
  (r.image_mono.le_map_sup s t)

@[simp]
lemma image_id (s : set α) : image (@eq α) s = s :=
by { ext x, simp [mem_image] }

lemma image_comp (s : rel β γ) (t : set α) : image (r ∘ s) t = image s (image r t) :=
begin
  ext z, simp only [mem_image], split,
  { rintros ⟨x, xt, y, rxy, syz⟩, exact ⟨y, ⟨x, xt, rxy⟩, syz⟩ },
  rintros ⟨y, ⟨x, xt, rxy⟩, syz⟩, exact ⟨x, xt, y, rxy, syz⟩
end

lemma image_univ : r.image set.univ = r.codom := by { ext y, simp [mem_image, codom] }

/-- Preimage of a set under a relation `r`. Same as the image of `s` under `r.inv` -/
def preimage (s : set β) : set α := r.inv.image s

lemma mem_preimage (x : α) (s : set β) : x ∈ r.preimage s ↔ ∃ y ∈ s, r x y :=
iff.rfl

lemma preimage_def (s : set β) : preimage r s = {x | ∃ y ∈ s, r x y} :=
set.ext $ λ x, mem_preimage _ _ _

lemma preimage_mono {s t : set β} (h : s ⊆ t) : r.preimage s ⊆ r.preimage t :=
image_mono _ h

lemma preimage_inter (s t : set β) : r.preimage (s ∩ t) ⊆ r.preimage s ∩ r.preimage t :=
image_inter _ s t

lemma preimage_union (s t : set β) : r.preimage (s ∪ t) = r.preimage s ∪ r.preimage t :=
image_union _ s t

lemma preimage_id (s : set α) : preimage (@eq α) s = s :=
by simp only [preimage, inv_id, image_id]

lemma preimage_comp (s : rel β γ) (t : set γ) :
  preimage (r ∘ s) t = preimage r (preimage s t) :=
by simp only [preimage, inv_comp, image_comp]

lemma preimage_univ : r.preimage set.univ = r.dom :=
by { rw [preimage, image_univ, codom_inv] }

/-- Core of a set `s : set β` w.r.t `r : rel α β` is the set of `x : α` that are related *only*
to elements of `s`. Other generalization of `function.preimage`. -/
def core (s : set β) := {x | ∀ y, r x y → y ∈ s}

lemma mem_core (x : α) (s : set β) : x ∈ r.core s ↔ ∀ y, r x y → y ∈ s :=
iff.rfl

lemma core_subset : ((⊆) ⇒ (⊆)) r.core r.core :=
λ s t h x h' y rxy, h (h' y rxy)

lemma core_mono : monotone r.core := r.core_subset

lemma core_inter (s t : set β) : r.core (s ∩ t) = r.core s ∩ r.core t :=
set.ext (by simp [mem_core, imp_and_distrib, forall_and_distrib])

lemma core_union (s t : set β) : r.core s ∪ r.core t ⊆ r.core (s ∪ t) :=
r.core_mono.le_map_sup s t

@[simp] lemma core_univ : r.core set.univ = set.univ := set.ext (by simp [mem_core])

lemma core_id (s : set α) : core (@eq α) s = s :=
by simp [core]

lemma core_comp (s : rel β γ) (t : set γ) :
  core (r ∘ s) t = core r (core s t) :=
begin
  ext x, simp [core, comp], split,
  { exact λ h y rxy z, h z y rxy },
  { exact λ h z y rzy, h y rzy z }
end

/-- Restrict the domain of a relation to a subtype. -/
def restrict_domain (s : set α) : rel {x // x ∈ s} β :=
λ x y, r x.val y

theorem image_subset_iff (s : set α) (t : set β) : image r s ⊆ t ↔ s ⊆ core r t :=
iff.intro
  (λ h x xs y rxy, h ⟨x, xs, rxy⟩)
  (λ h y ⟨x, xs, rxy⟩, h xs y rxy)

end rel

namespace function

/-- The graph of a function as a relation. -/
def graph (f : α → β) : rel α β := λ x y, f x = y

end function

namespace set

-- TODO: if image were defined with bounded quantification in corelib, the next two would
-- be definitional

lemma image_eq (f : α → β) (s : set α) : f '' s = (function.graph f).image s :=
by simp [set.image, function.graph, rel.image]

lemma preimage_eq (f : α → β) (s : set β) :
  f ⁻¹' s = (function.graph f).preimage s :=
by simp [set.preimage, function.graph, rel.preimage, rel.inv, flip, rel.image]

lemma preimage_eq_core (f : α → β) (s : set β) :
  f ⁻¹' s = (function.graph f).core s :=
 by simp [set.preimage, function.graph, rel.core]

end set