/-
Copyright (c) 2021 Yaël Dillies. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies
-/
import data.sigma.lex
import order.bounded_order
import order.lexicographic

/-!
# Orders on a sigma type

This file defines two orders on a sigma type:
* The disjoint sum of orders. `a` is less `b` iff `a` and `b` are in the same summand and `a` is
  less than `b` there.
* The lexicographical order. `a` is less than `b` if its summand is strictly less than the summand
  of `b` or they are in the same summand and `a` is less than `b` there.

We make the disjoint sum of orders the default set of instances. The lexicographic order goes on a
type synonym.

## Notation

* `Σₗ i, α i`: Sigma type equipped with the lexicographic order. Type synonym of `Σ i, α i`.

## See also

Related files are:
* `data.finset.colex`: Colexicographic order on finite sets.
* `data.list.lex`: Lexicographic order on lists.
* `data.psigma.order`: Lexicographic order on `Σₗ' i, α i`. Basically a twin of this file.
* `order.lexicographic`: Lexicographic order on `α × β`.

## TODO

Prove that a sigma type is a `no_max_order`, `no_min_order`, `densely_ordered` when its summands
are.

Upgrade `equiv.sigma_congr_left`, `equiv.sigma_congr`, `equiv.sigma_assoc`,
`equiv.sigma_prod_of_equiv`, `equiv.sigma_equiv_prod`, ... to order isomorphisms.
-/

namespace sigma
variables {ι : Type*} {α : ι → Type*}

/-! ### Disjoint sum of orders on `sigma` -/

/-- Disjoint sum of orders. `⟨i, a⟩ ≤ ⟨j, b⟩` iff `i = j` and `a ≤ b`. -/
inductive le [Π i, has_le (α i)] : Π a b : Σ i, α i, Prop
| fiber (i : ι) (a b : α i) : a ≤ b → le ⟨i, a⟩ ⟨i, b⟩

/-- Disjoint sum of orders. `⟨i, a⟩ < ⟨j, b⟩` iff `i = j` and `a < b`. -/
inductive lt [Π i, has_lt (α i)] : Π a b : Σ i, α i, Prop
| fiber (i : ι) (a b : α i) : a < b → lt ⟨i, a⟩ ⟨i, b⟩

instance [Π i, has_le (α i)] : has_le (Σ i, α i) := ⟨le⟩
instance [Π i, has_lt (α i)] : has_lt (Σ i, α i) := ⟨lt⟩

@[simp] lemma mk_le_mk_iff [Π i, has_le (α i)] {i : ι} {a b : α i} :
  (⟨i, a⟩ : sigma α) ≤ ⟨i, b⟩ ↔ a ≤ b :=
⟨λ ⟨_, _, _, h⟩, h, le.fiber _ _ _⟩

@[simp] lemma mk_lt_mk_iff [Π i, has_lt (α i)] {i : ι} {a b : α i} :
  (⟨i, a⟩ : sigma α) < ⟨i, b⟩ ↔ a < b :=
⟨λ ⟨_, _, _, h⟩, h, lt.fiber _ _ _⟩

lemma lt_def [Π i, has_lt (α i)] {a b : Σ i, α i} : a < b ↔ ∃ h : a.1 = b.1, h.rec a.2 < b.2 :=
begin
  split,
  { rintro ⟨i, a, b, h⟩,
    exact ⟨rfl, h⟩ },
  { obtain ⟨i, a⟩ := a,
    obtain ⟨j, b⟩ := b,
    rintro ⟨(rfl : i = j), h⟩,
    exact lt.fiber _ _ _ h }
end

instance [Π i, preorder (α i)] : preorder (Σ i, α i) :=
{ le_refl := λ ⟨i, a⟩, le.fiber i a a le_rfl,
  le_trans := begin
    rintro _ _ _ ⟨i, a, b, hab⟩ ⟨_, _, c, hbc⟩,
    exact le.fiber i a c (hab.trans hbc),
  end,
  lt_iff_le_not_le := λ _ _, begin
    split,
    { rintro ⟨i, a, b, hab⟩,
      rwa [mk_le_mk_iff, mk_le_mk_iff, ←lt_iff_le_not_le] },
    { rintro ⟨⟨i, a, b, hab⟩, h⟩,
      rw mk_le_mk_iff at h,
      exact mk_lt_mk_iff.2 (hab.lt_of_not_le h) }
  end,
  .. sigma.has_le,
  .. sigma.has_lt }

instance [Π i, partial_order (α i)] : partial_order (Σ i, α i) :=
{ le_antisymm := begin
    rintro _ _ ⟨i, a, b, hab⟩ ⟨_, _, _, hba⟩,
    exact ext rfl (heq_of_eq $ hab.antisymm hba),
  end,
  .. sigma.preorder }

/-! ### Lexicographical order on `sigma` -/

namespace lex

notation `Σₗ` binders `, ` r:(scoped p, _root_.lex (sigma p)) := r

/-- The lexicographical `≤` on a sigma type. -/
instance has_le [has_lt ι] [Π i, has_le (α i)] : has_le (Σₗ i, α i) := ⟨lex (<) (λ i, (≤))⟩

/-- The lexicographical `<` on a sigma type. -/
instance has_lt [has_lt ι] [Π i, has_lt (α i)] : has_lt (Σₗ i, α i) := ⟨lex (<) (λ i, (<))⟩

/-- The lexicographical preorder on a sigma type. -/
instance preorder [preorder ι] [Π i, preorder (α i)] : preorder (Σₗ i, α i) :=
{ le_refl := λ ⟨i, a⟩, lex.right a a le_rfl,
  le_trans := λ _ _ _, trans_of (lex (<) $ λ _, (≤)),
  lt_iff_le_not_le := begin
    refine λ a b, ⟨λ hab, ⟨hab.mono_right (λ i a b, le_of_lt), _⟩, _⟩,
    { rintro (⟨j, i, b, a, hji⟩ | ⟨i, b, a, hba⟩);
        obtain (⟨_, _, _, _, hij⟩ | ⟨_, _, _, hab⟩) := hab,
      { exact hij.not_lt hji },
      { exact lt_irrefl _ hji },
      { exact lt_irrefl _ hij },
      { exact hab.not_le hba } },
    { rintro ⟨⟨i, j, a, b, hij⟩ |⟨i, a, b, hab⟩, hba⟩,
      { exact lex.left _ _ hij },
      { exact lex.right _ _ (hab.lt_of_not_le $ λ h, hba $ lex.right _ _ h) } }
  end,
  .. lex.has_le,
  .. lex.has_lt }

/-- The lexicographical partial order on a sigma type. -/
instance partial_order [preorder ι] [Π i, partial_order (α i)] :
  partial_order (Σₗ i, α i) :=
{ le_antisymm := λ _ _, antisymm_of (lex (<) $ λ _, (≤)),
  .. lex.preorder }

/-- The lexicographical linear order on a sigma type. -/
instance linear_order [linear_order ι] [Π i, linear_order (α i)] :
  linear_order (Σₗ i, α i) :=
{ le_total := total_of (lex (<) $ λ _, (≤)),
  decidable_eq := sigma.decidable_eq,
  decidable_le := lex.decidable _ _,
  .. lex.partial_order }

/-- The lexicographical linear order on a sigma type. -/
instance order_bot [partial_order ι] [order_bot ι] [Π i, preorder (α i)] [order_bot (α ⊥)] :
  order_bot (Σₗ i, α i) :=
{ bot := ⟨⊥, ⊥⟩,
  bot_le := λ ⟨a, b⟩, begin
    obtain rfl | ha := eq_bot_or_bot_lt a,
    { exact lex.right _ _ bot_le },
    { exact lex.left _ _ ha }
  end }

/-- The lexicographical linear order on a sigma type. -/
instance order_top [partial_order ι] [order_top ι] [Π i, preorder (α i)] [order_top (α ⊤)] :
  order_top (Σₗ i, α i) :=
{ top := ⟨⊤, ⊤⟩,
  le_top := λ ⟨a, b⟩, begin
    obtain rfl | ha := eq_top_or_lt_top a,
    { exact lex.right _ _ le_top },
    { exact lex.left _ _ ha }
  end }

/-- The lexicographical linear order on a sigma type. -/
instance bounded_order [partial_order ι] [bounded_order ι] [Π i, preorder (α i)]
  [order_bot (α ⊥)] [order_top (α ⊤)] :
  bounded_order (Σₗ i, α i) :=
{ .. lex.order_bot, .. lex.order_top }

end lex
end sigma


import data.int.basic
import tactic.linear_combination
import tactic.linarith

structure int_plane_non_zero :=
  (fst : ℤ)
  (snd : ℤ)
  (non_zero : snd ≠ 0)

def S (r s : int_plane_non_zero) : Prop :=
  r.1 * s.2 = s.1 * r.2

lemma S_def (r s : int_plane_non_zero) :
  S r s ↔ r.1 * s.2 = s.1 * r.2 :=
by refl

lemma S_refl : reflexive S :=
  λ r, by rw S_def

lemma S_symm : symmetric S :=
begin
  intros r s hrs,
  rw S_def at *,
  exact hrs.symm,
end

lemma S_trans : transitive S :=
begin
  intros r s t hrs hst,
  rw S_def at *,
  rw ← mul_right_inj' (s.non_zero),
  linear_combination t.snd * hrs + r.snd * hst,
end

lemma S_equiv : equivalence S :=
begin
  exact ⟨S_refl, S_symm, S_trans⟩,
end

instance s : setoid (int_plane_non_zero) :=
  { r     := S,
    iseqv := S_equiv }

notation `myrat` := quotient s

attribute [instance] s

namespace «myrat»

lemma equiv_def
  (r s : int_plane_non_zero)
  : r ≈ s ↔ r.1 * s.2 = s.1 * r.2 :=
begin
  refl
end

instance : has_zero myrat :=
  ⟨⟦(⟨0, 1, by norm_num⟩ : int_plane_non_zero)⟧⟩

instance : has_inv myrat :=
  { inv := quotient.lift (λ x : int_plane_non_zero,
                          (if h : x.1 = 0 then (0 : myrat)
                                          else ⟦⟨x.2, x.1, h⟩⟧ : myrat))
    begin
      rintros ⟨n, d, hd⟩ ⟨n', d', hd'⟩ (h : n*d' = n'*d),
      dsimp,
      split_ifs,
      { refl },
      { by finish },
    { by finish },
    { sorry },
    end }

end «myrat»


import tactic.interactive

-- lean forces me to write noncomputable
noncomputable def g {X Y : Type} (f : X → Y) (hf : function.bijective f) : Y → X :=
begin
  intro y,
  have h := hf.2 y,
  choose x hx using h,
  use x
end

#print g -- it's supposed to be noncomputable but it looks like a computer program to me

-- Here I don't need to write noncomputable
theorem g_property {X Y : Type} (f : X → Y) (hf : function.bijective f) (y : Y) :
  f (g f hf y) = y :=
begin
  exact classical.some_spec (hf.2 y)
end

#print axioms g_property -- classical.choice
-- I used the axiom of choice but I'm computable anyway.

-- and this is computable
def lem (P : Prop) : P ∨ ¬ P := classical.em P

#print axioms lem -- all the axioms

-- computable, apparently
theorem g_exists {X Y : Type} (f : X → Y) (hf : function.bijective f) :
  ∃ g : Y → X, true :=
begin
  use g f hf,
end

/- noncomputable mode isn't permanently on though, because this still fails:
def rightinv'' {X Y : Type} (f : X → Y) (hf : function.bijective f) : Y → X :=
begin
  intro y,
  have h := hf.2 y,
  choose x hx using h,
  use x
end
-/

section
open function
variables {α : Type*} [has_zero α] [has_one α] [has_add α] [has_mul α] [has_neg α]
variables {β : Type*} [comm_ring β]

def comm_ring_of_injective (f : α → β) (inj : injective f)
  (zero : f 0 = 0) (one : f 1 = 1) (add : ∀ {x y}, f (x + y) = f x + f y)
  (mul : ∀ {x y}, f (x * y) = f x * f y) (neg : ∀ {x}, f (-x) = - f x) :
  comm_ring α :=
begin
  refine_struct { ..‹has_zero α›, ..‹has_one α›, ..‹has_add α›, ..‹has_mul α›, ..‹has_neg α› },
  all_goals {sorry}
end

end


/-
Copyright (c) 2020 Aaron Anderson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Aaron Anderson
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.finset.nat_antidiagonal
import Mathlib.algebra.big_operators.basic
import Mathlib.PostPort

universes u_1 u_2

namespace Mathlib

/-!
# Big operators for `nat_antidiagonal`

This file contains theorems relevant to big operators over `finset.nat.antidiagonal`.
-/

namespace finset

namespace nat

theorem prod_antidiagonal_succ {M : Type u_1} [comm_monoid M] {n : ℕ} {f : ℕ × ℕ → M} :
    (finset.prod (antidiagonal (n + 1)) fun (p : ℕ × ℕ) => f p) =
        f (0, n + 1) *
          finset.prod (antidiagonal n) fun (p : ℕ × ℕ) => f (prod.fst p + 1, prod.snd p) :=
  sorry

theorem sum_antidiagonal_succ {N : Type u_2} [add_comm_monoid N] {n : ℕ} {f : ℕ × ℕ → N} :
    (finset.sum (antidiagonal (n + 1)) fun (p : ℕ × ℕ) => f p) =
        f (0, n + 1) +
          finset.sum (antidiagonal n) fun (p : ℕ × ℕ) => f (prod.fst p + 1, prod.snd p) :=
  prod_antidiagonal_succ

theorem sum_antidiagonal_swap {M : Type u_1} [add_comm_monoid M] {n : ℕ} {f : ℕ × ℕ → M} :
    (finset.sum (antidiagonal n) fun (p : ℕ × ℕ) => f (prod.swap p)) =
        finset.sum (antidiagonal n) fun (p : ℕ × ℕ) => f p :=
  sorry

theorem prod_antidiagonal_succ' {M : Type u_1} [comm_monoid M] {n : ℕ} {f : ℕ × ℕ → M} :
    (finset.prod (antidiagonal (n + 1)) fun (p : ℕ × ℕ) => f p) =
        f (n + 1, 0) *
          finset.prod (antidiagonal n) fun (p : ℕ × ℕ) => f (prod.fst p, prod.snd p + 1) :=
  sorry

theorem sum_antidiagonal_succ' {N : Type u_2} [add_comm_monoid N] {n : ℕ} {f : ℕ × ℕ → N} :
    (finset.sum (antidiagonal (n + 1)) fun (p : ℕ × ℕ) => f p) =
        f (n + 1, 0) +
          finset.sum (antidiagonal n) fun (p : ℕ × ℕ) => f (prod.fst p, prod.snd p + 1) :=
  prod_antidiagonal_succ'

theorem prod_antidiagonal_subst {M : Type u_1} [comm_monoid M] {n : ℕ} {f : ℕ × ℕ → ℕ → M} :
    (finset.prod (antidiagonal n) fun (p : ℕ × ℕ) => f p n) =
        finset.prod (antidiagonal n) fun (p : ℕ × ℕ) => f p (prod.fst p + prod.snd p) :=
  sorry

theorem prod_antidiagonal_eq_prod_range_succ {M : Type u_1} [comm_monoid M] (f : ℕ → ℕ → M)
    (n : ℕ) :
    (finset.prod (antidiagonal n) fun (ij : ℕ × ℕ) => f (prod.fst ij) (prod.snd ij)) =
        finset.prod (range (Nat.succ n)) fun (k : ℕ) => f k (n - k) :=
  sorry

end Mathlib


/-
Copyright (c) 2021 Alena Gusakov, Bhavik Mehta, Kyle Miller. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Alena Gusakov, Bhavik Mehta, Kyle Miller

! This file was ported from Lean 3 source module combinatorics.hall.basic
! leanprover-community/mathlib commit 8195826f5c428fc283510bc67303dd4472d78498
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Combinatorics.Hall.Finite
import Mathbin.CategoryTheory.CofilteredSystem
import Mathbin.Data.Rel

/-!
# Hall's Marriage Theorem

Given a list of finite subsets $X_1, X_2, \dots, X_n$ of some given set
$S$, P. Hall in [Hall1935] gave a necessary and sufficient condition for
there to be a list of distinct elements $x_1, x_2, \dots, x_n$ with
$x_i\in X_i$ for each $i$: it is when for each $k$, the union of every
$k$ of these subsets has at least $k$ elements.

Rather than a list of finite subsets, one may consider indexed families
`t : ι → finset α` of finite subsets with `ι` a `fintype`, and then the list
of distinct representatives is given by an injective function `f : ι → α`
such that `∀ i, f i ∈ t i`, called a *matching*.
This version is formalized as `finset.all_card_le_bUnion_card_iff_exists_injective'`
in a separate module.

The theorem can be generalized to remove the constraint that `ι` be a `fintype`.
As observed in [Halpern1966], one may use the constrained version of the theorem
in a compactness argument to remove this constraint.
The formulation of compactness we use is that inverse limits of nonempty finite sets
are nonempty (`nonempty_sections_of_finite_inverse_system`), which uses the
Tychonoff theorem.
The core of this module is constructing the inverse system: for every finite subset `ι'` of
`ι`, we can consider the matchings on the restriction of the indexed family `t` to `ι'`.

## Main statements

* `finset.all_card_le_bUnion_card_iff_exists_injective` is in terms of `t : ι → finset α`.
* `fintype.all_card_le_rel_image_card_iff_exists_injective` is in terms of a relation
  `r : α → β → Prop` such that `rel.image r {a}` is a finite set for all `a : α`.
* `fintype.all_card_le_filter_rel_iff_exists_injective` is in terms of a relation
  `r : α → β → Prop` on finite types, with the Hall condition given in terms of
  `finset.univ.filter`.

## Todo

* The statement of the theorem in terms of bipartite graphs is in preparation.

## Tags

Hall's Marriage Theorem, indexed families
-/

open Finset

universe u v

/-- The set of matchings for `t` when restricted to a `finset` of `ι`. -/
def hallMatchingsOn {ι : Type u} {α : Type v} (t : ι → Finset α) (ι' : Finset ι) :=
  { f : ι' → α | Function.Injective f ∧ ∀ x, f x ∈ t x }
#align hall_matchings_on hallMatchingsOn

/-- Given a matching on a finset, construct the restriction of that matching to a subset. -/
def hallMatchingsOn.restrict {ι : Type u} {α : Type v} (t : ι → Finset α) {ι' ι'' : Finset ι}
    (h : ι' ⊆ ι'') (f : hallMatchingsOn t ι'') : hallMatchingsOn t ι' :=
  by
  refine' ⟨fun i => f.val ⟨i, h i.property⟩, _⟩
  cases' f.property with hinj hc
  refine' ⟨_, fun i => hc ⟨i, h i.property⟩⟩
  rintro ⟨i, hi⟩ ⟨j, hj⟩ hh
  simpa only [Subtype.mk_eq_mk] using hinj hh
#align hall_matchings_on.restrict hallMatchingsOn.restrict

/-- When the Hall condition is satisfied, the set of matchings on a finite set is nonempty.
This is where `finset.all_card_le_bUnion_card_iff_exists_injective'` comes into the argument. -/
theorem hallMatchingsOn.nonempty {ι : Type u} {α : Type v} [DecidableEq α] (t : ι → Finset α)
    (h : ∀ s : Finset ι, s.card ≤ (s.bunionᵢ t).card) (ι' : Finset ι) :
    Nonempty (hallMatchingsOn t ι') := by
  classical
    refine' ⟨Classical.indefiniteDescription _ _⟩
    apply (all_card_le_bUnion_card_iff_exists_injective' fun i : ι' => t i).mp
    intro s'
    convert h (s'.image coe) using 1
    simp only [card_image_of_injective s' Subtype.coe_injective]
    rw [image_bUnion]
#align hall_matchings_on.nonempty hallMatchingsOn.nonempty

-- TODO: This takes a long time to elaborate for an unknown reason.
/-- This is the `hall_matchings_on` sets assembled into a directed system.
-/
def hallMatchingsFunctor {ι : Type u} {α : Type v} (t : ι → Finset α) : (Finset ι)ᵒᵖ ⥤ Type max u v
    where
  obj ι' := hallMatchingsOn t ι'.unop
  map ι' ι'' g f := hallMatchingsOn.restrict t (CategoryTheory.leOfHom g.unop) f
#align hall_matchings_functor hallMatchingsFunctor

instance hallMatchingsOn.finite {ι : Type u} {α : Type v} (t : ι → Finset α) (ι' : Finset ι) :
    Finite (hallMatchingsOn t ι') := by
  classical
    rw [hallMatchingsOn]
    let g : hallMatchingsOn t ι' → ι' → ι'.bUnion t :=
      by
      rintro f i
      refine' ⟨f.val i, _⟩
      rw [mem_bUnion]
      exact ⟨i, i.property, f.property.2 i⟩
    apply Finite.of_injective g
    intro f f' h
    simp only [g, Function.funext_iff, Subtype.val_eq_coe] at h
    ext a
    exact h a
#align hall_matchings_on.finite hallMatchingsOn.finite

/-- This is the version of **Hall's Marriage Theorem** in terms of indexed
families of finite sets `t : ι → finset α`.  It states that there is a
set of distinct representatives if and only if every union of `k` of the
sets has at least `k` elements.

Recall that `s.bUnion t` is the union of all the sets `t i` for `i ∈ s`.

This theorem is bootstrapped from `finset.all_card_le_bUnion_card_iff_exists_injective'`,
which has the additional constraint that `ι` is a `fintype`.
-/
theorem Finset.all_card_le_bunionᵢ_card_iff_exists_injective {ι : Type u} {α : Type v}
    [DecidableEq α] (t : ι → Finset α) :
    (∀ s : Finset ι, s.card ≤ (s.bunionᵢ t).card) ↔
      ∃ f : ι → α, Function.Injective f ∧ ∀ x, f x ∈ t x :=
  by
  constructor
  · intro h
    -- Set up the functor
    haveI : ∀ ι' : (Finset ι)ᵒᵖ, Nonempty ((hallMatchingsFunctor t).obj ι') := fun ι' =>
      hallMatchingsOn.nonempty t h ι'.unop
    classical
      haveI : ∀ ι' : (Finset ι)ᵒᵖ, Finite ((hallMatchingsFunctor t).obj ι') :=
        by
        intro ι'
        rw [hallMatchingsFunctor]
        infer_instance
      -- Apply the compactness argument
      obtain ⟨u, hu⟩ := nonempty_sections_of_finite_inverse_system (hallMatchingsFunctor t)
      -- Interpret the resulting section of the inverse limit
      refine' ⟨_, _, _⟩
      ·-- Build the matching function from the section
        exact fun i =>
          (u (Opposite.op ({i} : Finset ι))).val ⟨i, by simp only [Opposite.unop_op, mem_singleton]⟩
      · -- Show that it is injective
        intro i i'
        have subi : ({i} : Finset ι) ⊆ {i, i'} := by simp
        have subi' : ({i'} : Finset ι) ⊆ {i, i'} := by simp
        have le : ∀ {s t : Finset ι}, s ⊆ t → s ≤ t := fun _ _ h => h
        rw [← hu (CategoryTheory.homOfLE (le subi)).op, ← hu (CategoryTheory.homOfLE (le subi')).op]
        let uii' := u (Opposite.op ({i, i'} : Finset ι))
        exact fun h => subtype.mk_eq_mk.mp (uii'.property.1 h)
      · -- Show that it maps each index to the corresponding finite set
        intro i
        apply (u (Opposite.op ({i} : Finset ι))).property.2
  · -- The reverse direction is a straightforward cardinality argument
    rintro ⟨f, hf₁, hf₂⟩ s
    rw [← Finset.card_image_of_injective s hf₁]
    apply Finset.card_le_of_subset
    intro
    rw [Finset.mem_image, Finset.mem_bunionᵢ]
    rintro ⟨x, hx, rfl⟩
    exact ⟨x, hx, hf₂ x⟩
#align finset.all_card_le_bUnion_card_iff_exists_injective Finset.all_card_le_bunionᵢ_card_iff_exists_injective

/-- Given a relation such that the image of every singleton set is finite, then the image of every
finite set is finite. -/
instance {α : Type u} {β : Type v} [DecidableEq β] (r : α → β → Prop)
    [∀ a : α, Fintype (Rel.image r {a})] (A : Finset α) : Fintype (Rel.image r A) :=
  by
  have h : Rel.image r A = (A.bUnion fun a => (Rel.image r {a}).toFinset : Set β) :=
    by
    ext
    simp [Rel.image]
  rw [h]
  apply FinsetCoe.fintype

/-- This is a version of **Hall's Marriage Theorem** in terms of a relation
between types `α` and `β` such that `α` is finite and the image of
each `x : α` is finite (it suffices for `β` to be finite; see
`fintype.all_card_le_filter_rel_iff_exists_injective`).  There is
a transversal of the relation (an injective function `α → β` whose graph is
a subrelation of the relation) iff every subset of
`k` terms of `α` is related to at least `k` terms of `β`.

Note: if `[fintype β]`, then there exist instances for `[∀ (a : α), fintype (rel.image r {a})]`.
-/
theorem Fintype.all_card_le_rel_image_card_iff_exists_injective {α : Type u} {β : Type v}
    [DecidableEq β] (r : α → β → Prop) [∀ a : α, Fintype (Rel.image r {a})] :
    (∀ A : Finset α, A.card ≤ Fintype.card (Rel.image r A)) ↔
      ∃ f : α → β, Function.Injective f ∧ ∀ x, r x (f x) :=
  by
  let r' a := (Rel.image r {a}).toFinset
  have h : ∀ A : Finset α, Fintype.card (Rel.image r A) = (A.bunionᵢ r').card :=
    by
    intro A
    rw [← Set.toFinset_card]
    apply congr_arg
    ext b
    simp [Rel.image]
  have h' : ∀ (f : α → β) (x), r x (f x) ↔ f x ∈ r' x := by simp [Rel.image]
  simp only [h, h']
  apply Finset.all_card_le_bunionᵢ_card_iff_exists_injective
#align fintype.all_card_le_rel_image_card_iff_exists_injective Fintype.all_card_le_rel_image_card_iff_exists_injective

-- TODO: decidable_pred makes Yael sad. When an appropriate decidable_rel-like exists, fix it.
/-- This is a version of **Hall's Marriage Theorem** in terms of a relation to a finite type.
There is a transversal of the relation (an injective function `α → β` whose graph is a subrelation
of the relation) iff every subset of `k` terms of `α` is related to at least `k` terms of `β`.

It is like `fintype.all_card_le_rel_image_card_iff_exists_injective` but uses `finset.filter`
rather than `rel.image`.
-/
theorem Fintype.all_card_le_filter_rel_iff_exists_injective {α : Type u} {β : Type v} [Fintype β]
    (r : α → β → Prop) [∀ a, DecidablePred (r a)] :
    (∀ A : Finset α, A.card ≤ (univ.filterₓ fun b : β => ∃ a ∈ A, r a b).card) ↔
      ∃ f : α → β, Function.Injective f ∧ ∀ x, r x (f x) :=
  by
  haveI := Classical.decEq β
  let r' a := univ.filter fun b => r a b
  have h : ∀ A : Finset α, (univ.filter fun b : β => ∃ a ∈ A, r a b) = A.bunionᵢ r' :=
    by
    intro A
    ext b
    simp
  have h' : ∀ (f : α → β) (x), r x (f x) ↔ f x ∈ r' x := by simp
  simp_rw [h, h']
  apply Finset.all_card_le_bunionᵢ_card_iff_exists_injective
#align fintype.all_card_le_filter_rel_iff_exists_injective Fintype.all_card_le_filter_rel_iff_exists_injective


/-
Copyright (c) 2020 Yury G. Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury G. Kudryashov

! This file was ported from Lean 3 source module order.filter.countable_Inter
! leanprover-community/mathlib commit 4d392a6c9c4539cbeca399b3ee0afea398fbd2eb
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Order.Filter.Basic
import Mathbin.Data.Set.Countable

/-!
# Filters with countable intersection property

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

In this file we define `countable_Inter_filter` to be the class of filters with the following
property: for any countable collection of sets `s ∈ l` their intersection belongs to `l` as well.

Two main examples are the `residual` filter defined in `topology.metric_space.baire` and
the `measure.ae` filter defined in `measure_theory.measure_space`.

We reformulate the definition in terms of indexed intersection and in terms of `filter.eventually`
and provide instances for some basic constructions (`⊥`, `⊤`, `filter.principal`, `filter.map`,
`filter.comap`, `has_inf.inf`). We also provide a custom constructor `filter.of_countable_Inter`
that deduces two axioms of a `filter` from the countable intersection property.

## Tags
filter, countable
-/

open Set Filter

open Filter

variable {ι : Sort _} {α β : Type _}

#print CountableInterFilter /-
/-- A filter `l` has the countable intersection property if for any countable collection
of sets `s ∈ l` their intersection belongs to `l` as well. -/
class CountableInterFilter (l : Filter α) : Prop where
  countable_interₛ_mem' : ∀ {S : Set (Set α)} (hSc : S.Countable) (hS : ∀ s ∈ S, s ∈ l), ⋂₀ S ∈ l
#align countable_Inter_filter CountableInterFilter
-/

variable {l : Filter α} [CountableInterFilter l]

#print countable_interₛ_mem /-
theorem countable_interₛ_mem {S : Set (Set α)} (hSc : S.Countable) : ⋂₀ S ∈ l ↔ ∀ s ∈ S, s ∈ l :=
  ⟨fun hS s hs => mem_of_superset hS (interₛ_subset_of_mem hs),
    CountableInterFilter.countable_interₛ_mem' hSc⟩
#align countable_sInter_mem countable_interₛ_mem
-/

/- warning: countable_Inter_mem -> countable_interᵢ_mem is a dubious translation:
lean 3 declaration is
  forall {ι : Sort.{u1}} {α : Type.{u2}} {l : Filter.{u2} α} [_inst_1 : CountableInterFilter.{u2} α l] [_inst_2 : Countable.{u1} ι] {s : ι -> (Set.{u2} α)}, Iff (Membership.Mem.{u2, u2} (Set.{u2} α) (Filter.{u2} α) (Filter.hasMem.{u2} α) (Set.interᵢ.{u2, u1} α ι (fun (i : ι) => s i)) l) (forall (i : ι), Membership.Mem.{u2, u2} (Set.{u2} α) (Filter.{u2} α) (Filter.hasMem.{u2} α) (s i) l)
but is expected to have type
  forall {ι : Sort.{u2}} {α : Type.{u1}} {l : Filter.{u1} α} [_inst_1 : CountableInterFilter.{u1} α l] [_inst_2 : Countable.{u2} ι] {s : ι -> (Set.{u1} α)}, Iff (Membership.mem.{u1, u1} (Set.{u1} α) (Filter.{u1} α) (instMembershipSetFilter.{u1} α) (Set.interᵢ.{u1, u2} α ι (fun (i : ι) => s i)) l) (forall (i : ι), Membership.mem.{u1, u1} (Set.{u1} α) (Filter.{u1} α) (instMembershipSetFilter.{u1} α) (s i) l)
Case conversion may be inaccurate. Consider using '#align countable_Inter_mem countable_interᵢ_memₓ'. -/
theorem countable_interᵢ_mem [Countable ι] {s : ι → Set α} : (⋂ i, s i) ∈ l ↔ ∀ i, s i ∈ l :=
  interₛ_range s ▸ (countable_interₛ_mem (countable_range _)).trans forall_range_iff
#align countable_Inter_mem countable_interᵢ_mem

#print countable_bInter_mem /-
theorem countable_bInter_mem {ι : Type _} {S : Set ι} (hS : S.Countable) {s : ∀ i ∈ S, Set α} :
    (⋂ i ∈ S, s i ‹_›) ∈ l ↔ ∀ i ∈ S, s i ‹_› ∈ l :=
  by
  rw [bInter_eq_Inter]
  haveI := hS.to_encodable
  exact countable_Inter_mem.trans Subtype.forall
#align countable_bInter_mem countable_bInter_mem
-/

/- warning: eventually_countable_forall -> eventually_countable_forall is a dubious translation:
lean 3 declaration is
  forall {ι : Sort.{u1}} {α : Type.{u2}} {l : Filter.{u2} α} [_inst_1 : CountableInterFilter.{u2} α l] [_inst_2 : Countable.{u1} ι] {p : α -> ι -> Prop}, Iff (Filter.Eventually.{u2} α (fun (x : α) => forall (i : ι), p x i) l) (forall (i : ι), Filter.Eventually.{u2} α (fun (x : α) => p x i) l)
but is expected to have type
  forall {ι : Sort.{u2}} {α : Type.{u1}} {l : Filter.{u1} α} [_inst_1 : CountableInterFilter.{u1} α l] [_inst_2 : Countable.{u2} ι] {p : α -> ι -> Prop}, Iff (Filter.Eventually.{u1} α (fun (x : α) => forall (i : ι), p x i) l) (forall (i : ι), Filter.Eventually.{u1} α (fun (x : α) => p x i) l)
Case conversion may be inaccurate. Consider using '#align eventually_countable_forall eventually_countable_forallₓ'. -/
theorem eventually_countable_forall [Countable ι] {p : α → ι → Prop} :
    (∀ᶠ x in l, ∀ i, p x i) ↔ ∀ i, ∀ᶠ x in l, p x i := by
  simpa only [Filter.Eventually, set_of_forall] using
    @countable_interᵢ_mem _ _ l _ _ fun i => { x | p x i }
#align eventually_countable_forall eventually_countable_forall

#print eventually_countable_ball /-
theorem eventually_countable_ball {ι : Type _} {S : Set ι} (hS : S.Countable)
    {p : ∀ (x : α), ∀ i ∈ S, Prop} :
    (∀ᶠ x in l, ∀ i ∈ S, p x i ‹_›) ↔ ∀ i ∈ S, ∀ᶠ x in l, p x i ‹_› := by
  simpa only [Filter.Eventually, set_of_forall] using
    @countable_bInter_mem _ l _ _ _ hS fun i hi => { x | p x i hi }
#align eventually_countable_ball eventually_countable_ball
-/

/- warning: eventually_le.countable_Union -> EventuallyLE.countable_unionᵢ is a dubious translation:
lean 3 declaration is
  forall {ι : Sort.{u1}} {α : Type.{u2}} {l : Filter.{u2} α} [_inst_1 : CountableInterFilter.{u2} α l] [_inst_2 : Countable.{u1} ι] {s : ι -> (Set.{u2} α)} {t : ι -> (Set.{u2} α)}, (forall (i : ι), Filter.EventuallyLE.{u2, 0} α Prop Prop.le l (s i) (t i)) -> (Filter.EventuallyLE.{u2, 0} α Prop Prop.le l (Set.unionᵢ.{u2, u1} α ι (fun (i : ι) => s i)) (Set.unionᵢ.{u2, u1} α ι (fun (i : ι) => t i)))
but is expected to have type
  forall {ι : Sort.{u2}} {α : Type.{u1}} {l : Filter.{u1} α} [_inst_1 : CountableInterFilter.{u1} α l] [_inst_2 : Countable.{u2} ι] {s : ι -> (Set.{u1} α)} {t : ι -> (Set.{u1} α)}, (forall (i : ι), Filter.EventuallyLE.{u1, 0} α Prop Prop.le l (s i) (t i)) -> (Filter.EventuallyLE.{u1, 0} α Prop Prop.le l (Set.unionᵢ.{u1, u2} α ι (fun (i : ι) => s i)) (Set.unionᵢ.{u1, u2} α ι (fun (i : ι) => t i)))
Case conversion may be inaccurate. Consider using '#align eventually_le.countable_Union EventuallyLE.countable_unionᵢₓ'. -/
theorem EventuallyLE.countable_unionᵢ [Countable ι] {s t : ι → Set α} (h : ∀ i, s i ≤ᶠ[l] t i) :
    (⋃ i, s i) ≤ᶠ[l] ⋃ i, t i :=
  (eventually_countable_forall.2 h).mono fun x hst hs => mem_unionᵢ.2 <| (mem_unionᵢ.1 hs).imp hst
#align eventually_le.countable_Union EventuallyLE.countable_unionᵢ

/- warning: eventually_eq.countable_Union -> EventuallyEq.countable_unionᵢ is a dubious translation:
lean 3 declaration is
  forall {ι : Sort.{u1}} {α : Type.{u2}} {l : Filter.{u2} α} [_inst_1 : CountableInterFilter.{u2} α l] [_inst_2 : Countable.{u1} ι] {s : ι -> (Set.{u2} α)} {t : ι -> (Set.{u2} α)}, (forall (i : ι), Filter.EventuallyEq.{u2, 0} α Prop l (s i) (t i)) -> (Filter.EventuallyEq.{u2, 0} α Prop l (Set.unionᵢ.{u2, u1} α ι (fun (i : ι) => s i)) (Set.unionᵢ.{u2, u1} α ι (fun (i : ι) => t i)))
but is expected to have type
  forall {ι : Sort.{u2}} {α : Type.{u1}} {l : Filter.{u1} α} [_inst_1 : CountableInterFilter.{u1} α l] [_inst_2 : Countable.{u2} ι] {s : ι -> (Set.{u1} α)} {t : ι -> (Set.{u1} α)}, (forall (i : ι), Filter.EventuallyEq.{u1, 0} α Prop l (s i) (t i)) -> (Filter.EventuallyEq.{u1, 0} α Prop l (Set.unionᵢ.{u1, u2} α ι (fun (i : ι) => s i)) (Set.unionᵢ.{u1, u2} α ι (fun (i : ι) => t i)))
Case conversion may be inaccurate. Consider using '#align eventually_eq.countable_Union EventuallyEq.countable_unionᵢₓ'. -/
theorem EventuallyEq.countable_unionᵢ [Countable ι] {s t : ι → Set α} (h : ∀ i, s i =ᶠ[l] t i) :
    (⋃ i, s i) =ᶠ[l] ⋃ i, t i :=
  (EventuallyLE.countable_unionᵢ fun i => (h i).le).antisymm
    (EventuallyLE.countable_unionᵢ fun i => (h i).symm.le)
#align eventually_eq.countable_Union EventuallyEq.countable_unionᵢ

#print EventuallyLE.countable_bUnion /-
theorem EventuallyLE.countable_bUnion {ι : Type _} {S : Set ι} (hS : S.Countable)
    {s t : ∀ i ∈ S, Set α} (h : ∀ i ∈ S, s i ‹_› ≤ᶠ[l] t i ‹_›) :
    (⋃ i ∈ S, s i ‹_›) ≤ᶠ[l] ⋃ i ∈ S, t i ‹_› :=
  by
  simp only [bUnion_eq_Union]
  haveI := hS.to_encodable
  exact EventuallyLE.countable_unionᵢ fun i => h i i.2
#align eventually_le.countable_bUnion EventuallyLE.countable_bUnion
-/

#print EventuallyEq.countable_bUnion /-
theorem EventuallyEq.countable_bUnion {ι : Type _} {S : Set ι} (hS : S.Countable)
    {s t : ∀ i ∈ S, Set α} (h : ∀ i ∈ S, s i ‹_› =ᶠ[l] t i ‹_›) :
    (⋃ i ∈ S, s i ‹_›) =ᶠ[l] ⋃ i ∈ S, t i ‹_› :=
  (EventuallyLE.countable_bUnion hS fun i hi => (h i hi).le).antisymm
    (EventuallyLE.countable_bUnion hS fun i hi => (h i hi).symm.le)
#align eventually_eq.countable_bUnion EventuallyEq.countable_bUnion
-/

/- warning: eventually_le.countable_Inter -> EventuallyLE.countable_interᵢ is a dubious translation:
lean 3 declaration is
  forall {ι : Sort.{u1}} {α : Type.{u2}} {l : Filter.{u2} α} [_inst_1 : CountableInterFilter.{u2} α l] [_inst_2 : Countable.{u1} ι] {s : ι -> (Set.{u2} α)} {t : ι -> (Set.{u2} α)}, (forall (i : ι), Filter.EventuallyLE.{u2, 0} α Prop Prop.le l (s i) (t i)) -> (Filter.EventuallyLE.{u2, 0} α Prop Prop.le l (Set.interᵢ.{u2, u1} α ι (fun (i : ι) => s i)) (Set.interᵢ.{u2, u1} α ι (fun (i : ι) => t i)))
but is expected to have type
  forall {ι : Sort.{u2}} {α : Type.{u1}} {l : Filter.{u1} α} [_inst_1 : CountableInterFilter.{u1} α l] [_inst_2 : Countable.{u2} ι] {s : ι -> (Set.{u1} α)} {t : ι -> (Set.{u1} α)}, (forall (i : ι), Filter.EventuallyLE.{u1, 0} α Prop Prop.le l (s i) (t i)) -> (Filter.EventuallyLE.{u1, 0} α Prop Prop.le l (Set.interᵢ.{u1, u2} α ι (fun (i : ι) => s i)) (Set.interᵢ.{u1, u2} α ι (fun (i : ι) => t i)))
Case conversion may be inaccurate. Consider using '#align eventually_le.countable_Inter EventuallyLE.countable_interᵢₓ'. -/
theorem EventuallyLE.countable_interᵢ [Countable ι] {s t : ι → Set α} (h : ∀ i, s i ≤ᶠ[l] t i) :
    (⋂ i, s i) ≤ᶠ[l] ⋂ i, t i :=
  (eventually_countable_forall.2 h).mono fun x hst hs =>
    mem_interᵢ.2 fun i => hst _ (mem_interᵢ.1 hs i)
#align eventually_le.countable_Inter EventuallyLE.countable_interᵢ

/- warning: eventually_eq.countable_Inter -> EventuallyEq.countable_interᵢ is a dubious translation:
lean 3 declaration is
  forall {ι : Sort.{u1}} {α : Type.{u2}} {l : Filter.{u2} α} [_inst_1 : CountableInterFilter.{u2} α l] [_inst_2 : Countable.{u1} ι] {s : ι -> (Set.{u2} α)} {t : ι -> (Set.{u2} α)}, (forall (i : ι), Filter.EventuallyEq.{u2, 0} α Prop l (s i) (t i)) -> (Filter.EventuallyEq.{u2, 0} α Prop l (Set.interᵢ.{u2, u1} α ι (fun (i : ι) => s i)) (Set.interᵢ.{u2, u1} α ι (fun (i : ι) => t i)))
but is expected to have type
  forall {ι : Sort.{u2}} {α : Type.{u1}} {l : Filter.{u1} α} [_inst_1 : CountableInterFilter.{u1} α l] [_inst_2 : Countable.{u2} ι] {s : ι -> (Set.{u1} α)} {t : ι -> (Set.{u1} α)}, (forall (i : ι), Filter.EventuallyEq.{u1, 0} α Prop l (s i) (t i)) -> (Filter.EventuallyEq.{u1, 0} α Prop l (Set.interᵢ.{u1, u2} α ι (fun (i : ι) => s i)) (Set.interᵢ.{u1, u2} α ι (fun (i : ι) => t i)))
Case conversion may be inaccurate. Consider using '#align eventually_eq.countable_Inter EventuallyEq.countable_interᵢₓ'. -/
theorem EventuallyEq.countable_interᵢ [Countable ι] {s t : ι → Set α} (h : ∀ i, s i =ᶠ[l] t i) :
    (⋂ i, s i) =ᶠ[l] ⋂ i, t i :=
  (EventuallyLE.countable_interᵢ fun i => (h i).le).antisymm
    (EventuallyLE.countable_interᵢ fun i => (h i).symm.le)
#align eventually_eq.countable_Inter EventuallyEq.countable_interᵢ

#print EventuallyLE.countable_bInter /-
theorem EventuallyLE.countable_bInter {ι : Type _} {S : Set ι} (hS : S.Countable)
    {s t : ∀ i ∈ S, Set α} (h : ∀ i ∈ S, s i ‹_› ≤ᶠ[l] t i ‹_›) :
    (⋂ i ∈ S, s i ‹_›) ≤ᶠ[l] ⋂ i ∈ S, t i ‹_› :=
  by
  simp only [bInter_eq_Inter]
  haveI := hS.to_encodable
  exact EventuallyLE.countable_interᵢ fun i => h i i.2
#align eventually_le.countable_bInter EventuallyLE.countable_bInter
-/

#print EventuallyEq.countable_bInter /-
theorem EventuallyEq.countable_bInter {ι : Type _} {S : Set ι} (hS : S.Countable)
    {s t : ∀ i ∈ S, Set α} (h : ∀ i ∈ S, s i ‹_› =ᶠ[l] t i ‹_›) :
    (⋂ i ∈ S, s i ‹_›) =ᶠ[l] ⋂ i ∈ S, t i ‹_› :=
  (EventuallyLE.countable_bInter hS fun i hi => (h i hi).le).antisymm
    (EventuallyLE.countable_bInter hS fun i hi => (h i hi).symm.le)
#align eventually_eq.countable_bInter EventuallyEq.countable_bInter
-/

#print Filter.ofCountableInter /-
/-- Construct a filter with countable intersection property. This constructor deduces
`filter.univ_sets` and `filter.inter_sets` from the countable intersection property. -/
def Filter.ofCountableInter (l : Set (Set α))
    (hp : ∀ S : Set (Set α), S.Countable → S ⊆ l → ⋂₀ S ∈ l)
    (h_mono : ∀ s t, s ∈ l → s ⊆ t → t ∈ l) : Filter α
    where
  sets := l
  univ_sets := @interₛ_empty α ▸ hp _ countable_empty (empty_subset _)
  sets_of_superset := h_mono
  inter_sets s t hs ht :=
    interₛ_pair s t ▸
      hp _ ((countable_singleton _).insert _) (insert_subset.2 ⟨hs, singleton_subset_iff.2 ht⟩)
#align filter.of_countable_Inter Filter.ofCountableInter
-/

#print Filter.countable_Inter_ofCountableInter /-
instance Filter.countable_Inter_ofCountableInter (l : Set (Set α))
    (hp : ∀ S : Set (Set α), S.Countable → S ⊆ l → ⋂₀ S ∈ l)
    (h_mono : ∀ s t, s ∈ l → s ⊆ t → t ∈ l) :
    CountableInterFilter (Filter.ofCountableInter l hp h_mono) :=
  ⟨hp⟩
#align filter.countable_Inter_of_countable_Inter Filter.countable_Inter_ofCountableInter
-/

#print Filter.mem_ofCountableInter /-
@[simp]
theorem Filter.mem_ofCountableInter {l : Set (Set α)}
    (hp : ∀ S : Set (Set α), S.Countable → S ⊆ l → ⋂₀ S ∈ l) (h_mono : ∀ s t, s ∈ l → s ⊆ t → t ∈ l)
    {s : Set α} : s ∈ Filter.ofCountableInter l hp h_mono ↔ s ∈ l :=
  Iff.rfl
#align filter.mem_of_countable_Inter Filter.mem_ofCountableInter
-/

#print countableInterFilter_principal /-
instance countableInterFilter_principal (s : Set α) : CountableInterFilter (𝓟 s) :=
  ⟨fun S hSc hS => subset_interₛ hS⟩
#align countable_Inter_filter_principal countableInterFilter_principal
-/

/- warning: countable_Inter_filter_bot -> countableInterFilter_bot is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}}, CountableInterFilter.{u1} α (Bot.bot.{u1} (Filter.{u1} α) (CompleteLattice.toHasBot.{u1} (Filter.{u1} α) (Filter.completeLattice.{u1} α)))
but is expected to have type
  forall {α : Type.{u1}}, CountableInterFilter.{u1} α (Bot.bot.{u1} (Filter.{u1} α) (CompleteLattice.toBot.{u1} (Filter.{u1} α) (Filter.instCompleteLatticeFilter.{u1} α)))
Case conversion may be inaccurate. Consider using '#align countable_Inter_filter_bot countableInterFilter_botₓ'. -/
instance countableInterFilter_bot : CountableInterFilter (⊥ : Filter α) :=
  by
  rw [← principal_empty]
  apply countableInterFilter_principal
#align countable_Inter_filter_bot countableInterFilter_bot

/- warning: countable_Inter_filter_top -> countableInterFilter_top is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}}, CountableInterFilter.{u1} α (Top.top.{u1} (Filter.{u1} α) (Filter.hasTop.{u1} α))
but is expected to have type
  forall {α : Type.{u1}}, CountableInterFilter.{u1} α (Top.top.{u1} (Filter.{u1} α) (Filter.instTopFilter.{u1} α))
Case conversion may be inaccurate. Consider using '#align countable_Inter_filter_top countableInterFilter_topₓ'. -/
instance countableInterFilter_top : CountableInterFilter (⊤ : Filter α) :=
  by
  rw [← principal_univ]
  apply countableInterFilter_principal
#align countable_Inter_filter_top countableInterFilter_top

instance (l : Filter β) [CountableInterFilter l] (f : α → β) : CountableInterFilter (comap f l) :=
  by
  refine' ⟨fun S hSc hS => _⟩
  choose! t htl ht using hS
  have : (⋂ s ∈ S, t s) ∈ l := (countable_bInter_mem hSc).2 htl
  refine' ⟨_, this, _⟩
  simpa [preimage_Inter] using Inter₂_mono ht

instance (l : Filter α) [CountableInterFilter l] (f : α → β) : CountableInterFilter (map f l) :=
  by
  constructor; intro S hSc hS
  simp only [mem_map, sInter_eq_bInter, preimage_Inter₂] at hS⊢
  exact (countable_bInter_mem hSc).2 hS

/- warning: countable_Inter_filter_inf -> countableInterFilter_inf is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} (l₁ : Filter.{u1} α) (l₂ : Filter.{u1} α) [_inst_2 : CountableInterFilter.{u1} α l₁] [_inst_3 : CountableInterFilter.{u1} α l₂], CountableInterFilter.{u1} α (Inf.inf.{u1} (Filter.{u1} α) (Filter.hasInf.{u1} α) l₁ l₂)
but is expected to have type
  forall {α : Type.{u1}} (l₁ : Filter.{u1} α) (l₂ : Filter.{u1} α) [_inst_2 : CountableInterFilter.{u1} α l₁] [_inst_3 : CountableInterFilter.{u1} α l₂], CountableInterFilter.{u1} α (Inf.inf.{u1} (Filter.{u1} α) (Filter.instInfFilter.{u1} α) l₁ l₂)
Case conversion may be inaccurate. Consider using '#align countable_Inter_filter_inf countableInterFilter_infₓ'. -/
/-- Infimum of two `countable_Inter_filter`s is a `countable_Inter_filter`. This is useful, e.g.,
to automatically get an instance for `residual α ⊓ 𝓟 s`. -/
instance countableInterFilter_inf (l₁ l₂ : Filter α) [CountableInterFilter l₁]
    [CountableInterFilter l₂] : CountableInterFilter (l₁ ⊓ l₂) :=
  by
  refine' ⟨fun S hSc hS => _⟩
  choose s hs t ht hst using hS
  replace hs : (⋂ i ∈ S, s i ‹_›) ∈ l₁ := (countable_bInter_mem hSc).2 hs
  replace ht : (⋂ i ∈ S, t i ‹_›) ∈ l₂ := (countable_bInter_mem hSc).2 ht
  refine' mem_of_superset (inter_mem_inf hs ht) (subset_sInter fun i hi => _)
  rw [hst i hi]
  apply inter_subset_inter <;> exact Inter_subset_of_subset i (Inter_subset _ _)
#align countable_Inter_filter_inf countableInterFilter_inf

/- warning: countable_Inter_filter_sup -> countableInterFilter_sup is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} (l₁ : Filter.{u1} α) (l₂ : Filter.{u1} α) [_inst_2 : CountableInterFilter.{u1} α l₁] [_inst_3 : CountableInterFilter.{u1} α l₂], CountableInterFilter.{u1} α (Sup.sup.{u1} (Filter.{u1} α) (SemilatticeSup.toHasSup.{u1} (Filter.{u1} α) (Lattice.toSemilatticeSup.{u1} (Filter.{u1} α) (ConditionallyCompleteLattice.toLattice.{u1} (Filter.{u1} α) (CompleteLattice.toConditionallyCompleteLattice.{u1} (Filter.{u1} α) (Filter.completeLattice.{u1} α))))) l₁ l₂)
but is expected to have type
  forall {α : Type.{u1}} (l₁ : Filter.{u1} α) (l₂ : Filter.{u1} α) [_inst_2 : CountableInterFilter.{u1} α l₁] [_inst_3 : CountableInterFilter.{u1} α l₂], CountableInterFilter.{u1} α (Sup.sup.{u1} (Filter.{u1} α) (SemilatticeSup.toSup.{u1} (Filter.{u1} α) (Lattice.toSemilatticeSup.{u1} (Filter.{u1} α) (CompleteLattice.toLattice.{u1} (Filter.{u1} α) (Filter.instCompleteLatticeFilter.{u1} α)))) l₁ l₂)
Case conversion may be inaccurate. Consider using '#align countable_Inter_filter_sup countableInterFilter_supₓ'. -/
/-- Supremum of two `countable_Inter_filter`s is a `countable_Inter_filter`. -/
instance countableInterFilter_sup (l₁ l₂ : Filter α) [CountableInterFilter l₁]
    [CountableInterFilter l₂] : CountableInterFilter (l₁ ⊔ l₂) :=
  by
  refine' ⟨fun S hSc hS => ⟨_, _⟩⟩ <;> refine' (countable_interₛ_mem hSc).2 fun s hs => _
  exacts[(hS s hs).1, (hS s hs).2]
#align countable_Inter_filter_sup countableInterFilter_sup


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Mario Carneiro, Kevin Buzzard, Yury Kudryashov
-/
import algebra.module.submodule.basic
import algebra.punit_instances

/-!
# The lattice structure on `submodule`s

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

This file defines the lattice structure on submodules, `submodule.complete_lattice`, with `⊥`
defined as `{0}` and `⊓` defined as intersection of the underlying carrier.
If `p` and `q` are submodules of a module, `p ≤ q` means that `p ⊆ q`.

Many results about operations on this lattice structure are defined in `linear_algebra/basic.lean`,
most notably those which use `span`.

## Implementation notes

This structure should match the `add_submonoid.complete_lattice` structure, and we should try
to unify the APIs where possible.

-/

variables {R S M : Type*}

section add_comm_monoid
variables [semiring R] [semiring S] [add_comm_monoid M] [module R M] [module S M]
variables [has_smul S R] [is_scalar_tower S R M]
variables {p q : submodule R M}

namespace submodule

/-- The set `{0}` is the bottom element of the lattice of submodules. -/
instance : has_bot (submodule R M) :=
⟨{ carrier := {0}, smul_mem' := by simp { contextual := tt }, .. (⊥ : add_submonoid M)}⟩

instance inhabited' : inhabited (submodule R M) := ⟨⊥⟩

@[simp] lemma bot_coe : ((⊥ : submodule R M) : set M) = {0} := rfl
@[simp] lemma bot_to_add_submonoid : (⊥ : submodule R M).to_add_submonoid = ⊥ := rfl

section
variables (R)
@[simp] lemma restrict_scalars_bot : restrict_scalars S (⊥ : submodule R M) = ⊥ := rfl

@[simp] lemma mem_bot {x : M} : x ∈ (⊥ : submodule R M) ↔ x = 0 := set.mem_singleton_iff
end

@[simp] lemma restrict_scalars_eq_bot_iff {p : submodule R M} :
  restrict_scalars S p = ⊥ ↔ p = ⊥ :=
by simp [set_like.ext_iff]

instance unique_bot : unique (⊥ : submodule R M) :=
⟨infer_instance, λ x, subtype.ext $ (mem_bot R).1 x.mem⟩

instance : order_bot (submodule R M) :=
{ bot := ⊥,
  bot_le := λ p x, by simp [zero_mem] {contextual := tt} }

protected lemma eq_bot_iff (p : submodule R M) : p = ⊥ ↔ ∀ x ∈ p, x = (0 : M) :=
⟨ λ h, h.symm ▸ λ x hx, (mem_bot R).mp hx,
  λ h, eq_bot_iff.mpr (λ x hx, (mem_bot R).mpr (h x hx)) ⟩

@[ext] protected lemma bot_ext (x y : (⊥ : submodule R M)) : x = y :=
begin
  rcases x with ⟨x, xm⟩, rcases y with ⟨y, ym⟩, congr,
  rw (submodule.eq_bot_iff _).mp rfl x xm,
  rw (submodule.eq_bot_iff _).mp rfl y ym,
end

protected lemma ne_bot_iff (p : submodule R M) : p ≠ ⊥ ↔ ∃ x ∈ p, x ≠ (0 : M) :=
by { haveI := classical.prop_decidable, simp_rw [ne.def, p.eq_bot_iff, not_forall] }

lemma nonzero_mem_of_bot_lt {p : submodule R M} (bot_lt : ⊥ < p) : ∃ a : p, a ≠ 0 :=
let ⟨b, hb₁, hb₂⟩ := p.ne_bot_iff.mp bot_lt.ne' in ⟨⟨b, hb₁⟩, hb₂ ∘ (congr_arg coe)⟩

lemma exists_mem_ne_zero_of_ne_bot {p : submodule R M} (h : p ≠ ⊥) : ∃ b : M, b ∈ p ∧ b ≠ 0 :=
let ⟨b, hb₁, hb₂⟩ := p.ne_bot_iff.mp h in ⟨b, hb₁, hb₂⟩

/-- The bottom submodule is linearly equivalent to punit as an `R`-module. -/
@[simps] def bot_equiv_punit : (⊥ : submodule R M) ≃ₗ[R] punit :=
{ to_fun := λ x, punit.star,
  inv_fun := λ x, 0,
  map_add' := by { intros, ext, },
  map_smul' := by { intros, ext, },
  left_inv := by { intro x, ext, },
  right_inv := by { intro x, ext, }, }

lemma eq_bot_of_subsingleton (p : submodule R M) [subsingleton p] : p = ⊥ :=
begin
  rw eq_bot_iff,
  intros v hv,
  exact congr_arg coe (subsingleton.elim (⟨v, hv⟩ : p) 0)
end

/-- The universal set is the top element of the lattice of submodules. -/
instance : has_top (submodule R M) :=
⟨{ carrier := set.univ, smul_mem' := λ _ _ _, trivial, .. (⊤ : add_submonoid M)}⟩

@[simp] lemma top_coe : ((⊤ : submodule R M) : set M) = set.univ := rfl

@[simp] lemma top_to_add_submonoid : (⊤ : submodule R M).to_add_submonoid = ⊤ := rfl

@[simp] lemma mem_top {x : M} : x ∈ (⊤ : submodule R M) := trivial

section
variables (R)
@[simp] lemma restrict_scalars_top : restrict_scalars S (⊤ : submodule R M) = ⊤ := rfl
end

@[simp] lemma restrict_scalars_eq_top_iff {p : submodule R M} :
  restrict_scalars S p = ⊤ ↔ p = ⊤ :=
by simp [set_like.ext_iff]

instance : order_top (submodule R M) :=
{ top := ⊤,
  le_top := λ p x _, trivial }

lemma eq_top_iff' {p : submodule R M} : p = ⊤ ↔ ∀ x, x ∈ p :=
eq_top_iff.trans ⟨λ h x, h trivial, λ h x _, h x⟩

/-- The top submodule is linearly equivalent to the module.

This is the module version of `add_submonoid.top_equiv`. -/
@[simps] def top_equiv : (⊤ : submodule R M) ≃ₗ[R] M :=
{ to_fun := λ x, x,
  inv_fun := λ x, ⟨x, by simp⟩,
  map_add' := by { intros, refl, },
  map_smul' := by { intros, refl, },
  left_inv := by { intro x, ext, refl, },
  right_inv := by { intro x, refl, }, }

instance : has_Inf (submodule R M) :=
⟨λ S,
{ carrier   := ⋂ s ∈ S, (s : set M),
  zero_mem' := by simp [zero_mem],
  add_mem'  := by simp [add_mem] {contextual := tt},
  smul_mem' := by simp [smul_mem] {contextual := tt} }⟩

private lemma Inf_le' {S : set (submodule R M)} {p} : p ∈ S → Inf S ≤ p :=
set.bInter_subset_of_mem

private lemma le_Inf' {S : set (submodule R M)} {p} : (∀q ∈ S, p ≤ q) → p ≤ Inf S :=
set.subset_Inter₂

instance : has_inf (submodule R M) :=
⟨λ p q,
{ carrier   := p ∩ q,
  zero_mem' := by simp [zero_mem],
  add_mem'  := by simp [add_mem] {contextual := tt},
  smul_mem' := by simp [smul_mem] {contextual := tt} }⟩

instance : complete_lattice (submodule R M) :=
{ sup          := λ a b, Inf {x | a ≤ x ∧ b ≤ x},
  le_sup_left  := λ a b, le_Inf' $ λ x ⟨ha, hb⟩, ha,
  le_sup_right := λ a b, le_Inf' $ λ x ⟨ha, hb⟩, hb,
  sup_le       := λ a b c h₁ h₂, Inf_le' ⟨h₁, h₂⟩,
  inf          := (⊓),
  le_inf       := λ a b c, set.subset_inter,
  inf_le_left  := λ a b, set.inter_subset_left _ _,
  inf_le_right := λ a b, set.inter_subset_right _ _,
  Sup          := λtt, Inf {t | ∀t'∈tt, t' ≤ t},
  le_Sup       := λ s p hs, le_Inf' $ λ q hq, hq _ hs,
  Sup_le       := λ s p hs, Inf_le' hs,
  Inf          := Inf,
  le_Inf       := λ s a, le_Inf',
  Inf_le       := λ s a, Inf_le',
  ..submodule.order_top,
  ..submodule.order_bot,
  ..set_like.partial_order }

@[simp] theorem inf_coe : ↑(p ⊓ q) = (p ∩ q : set M) := rfl

@[simp] theorem mem_inf {p q : submodule R M} {x : M} :
  x ∈ p ⊓ q ↔ x ∈ p ∧ x ∈ q := iff.rfl

@[simp]

@[simp] theorem finset_inf_coe {ι} (s : finset ι) (p : ι → submodule R M) :
  (↑(s.inf p) : set M) = ⋂ i ∈ s, ↑(p i) :=
begin
  letI := classical.dec_eq ι,
  refine s.induction_on _ (λ i s hi ih, _),
  { simp },
  { rw [finset.inf_insert, inf_coe, ih],
    simp },
end

@[simp] theorem infi_coe {ι} (p : ι → submodule R M) :
  (↑⨅ i, p i : set M) = ⋂ i, ↑(p i) :=
by rw [infi, Inf_coe]; ext a; simp; exact
⟨λ h i, h _ i rfl, λ h i x e, e ▸ h _⟩

@[simp] lemma mem_Inf {S : set (submodule R M)} {x : M} : x ∈ Inf S ↔ ∀ p ∈ S, x ∈ p :=
set.mem_Inter₂

@[simp] theorem mem_infi {ι} (p : ι → submodule R M) {x} :
  x ∈ (⨅ i, p i) ↔ ∀ i, x ∈ p i :=
by rw [← set_like.mem_coe, infi_coe, set.mem_Inter]; refl

@[simp] theorem mem_finset_inf {ι} {s : finset ι} {p : ι → submodule R M} {x : M} :
  x ∈ s.inf p ↔ ∀ i ∈ s, x ∈ p i :=
by simp only [← set_like.mem_coe, finset_inf_coe, set.mem_Inter]

lemma mem_sup_left {S T : submodule R M} : ∀ {x : M}, x ∈ S → x ∈ S ⊔ T :=
show S ≤ S ⊔ T, from le_sup_left

lemma mem_sup_right {S T : submodule R M} : ∀ {x : M}, x ∈ T → x ∈ S ⊔ T :=
show T ≤ S ⊔ T, from le_sup_right

lemma add_mem_sup {S T : submodule R M} {s t : M} (hs : s ∈ S) (ht : t ∈ T) : s + t ∈ S ⊔ T :=
add_mem (mem_sup_left hs) (mem_sup_right ht)

lemma sub_mem_sup {R' M' : Type*} [ring R'] [add_comm_group M'] [module R' M']
  {S T : submodule R' M'} {s t : M'} (hs : s ∈ S) (ht : t ∈ T) :
  s - t ∈ S ⊔ T :=
begin
  rw sub_eq_add_neg,
  exact add_mem_sup hs (neg_mem ht),
end

lemma mem_supr_of_mem {ι : Sort*} {b : M} {p : ι → submodule R M} (i : ι) (h : b ∈ p i) :
  b ∈ (⨆i, p i) :=
have p i ≤ (⨆i, p i) := le_supr p i,
@this b h

open_locale big_operators

lemma sum_mem_supr {ι : Type*} [fintype ι] {f : ι → M} {p : ι → submodule R M}
  (h : ∀ i, f i ∈ p i) :
  ∑ i, f i ∈ ⨆ i, p i :=
sum_mem $ λ i hi, mem_supr_of_mem i (h i)

lemma sum_mem_bsupr {ι : Type*} {s : finset ι} {f : ι → M} {p : ι → submodule R M}
  (h : ∀ i ∈ s, f i ∈ p i) :
  ∑ i in s, f i ∈ ⨆ i ∈ s, p i :=
sum_mem $ λ i hi, mem_supr_of_mem i $ mem_supr_of_mem hi (h i hi)

/-! Note that `submodule.mem_supr` is provided in `linear_algebra/basic.lean`. -/

lemma mem_Sup_of_mem {S : set (submodule R M)} {s : submodule R M}
  (hs : s ∈ S) : ∀ {x : M}, x ∈ s → x ∈ Sup S :=
show s ≤ Sup S, from le_Sup hs

theorem disjoint_def {p p' : submodule R M} :
  disjoint p p' ↔ ∀ x ∈ p, x ∈ p' → x = (0:M) :=
disjoint_iff_inf_le.trans $ show (∀ x, x ∈ p ∧ x ∈ p' → x ∈ ({0} : set M)) ↔ _, by simp

theorem disjoint_def' {p p' : submodule R M} :
  disjoint p p' ↔ ∀ (x ∈ p) (y ∈ p'), x = y → x = (0:M) :=
disjoint_def.trans ⟨λ h x hx y hy hxy, h x hx $ hxy.symm ▸ hy,
  λ h x hx hx', h _ hx x hx' rfl⟩

lemma eq_zero_of_coe_mem_of_disjoint (hpq : disjoint p q) {a : p} (ha : (a : M) ∈ q) :
  a = 0 :=
by exact_mod_cast disjoint_def.mp hpq a (coe_mem a) ha

end submodule

section nat_submodule

/-- An additive submonoid is equivalent to a ℕ-submodule. -/
def add_submonoid.to_nat_submodule : add_submonoid M ≃o submodule ℕ M :=
{ to_fun := λ S,
  { smul_mem' := λ r s hs, show r • s ∈ S, from nsmul_mem hs _, ..S },
  inv_fun := submodule.to_add_submonoid,
  left_inv := λ ⟨S, _, _⟩, rfl,
  right_inv := λ ⟨S, _, _, _⟩, rfl,
  map_rel_iff' := λ a b, iff.rfl }

@[simp]
lemma add_submonoid.to_nat_submodule_symm :
  ⇑(add_submonoid.to_nat_submodule.symm : _ ≃o add_submonoid M) = submodule.to_add_submonoid := rfl

@[simp]
lemma add_submonoid.coe_to_nat_submodule (S : add_submonoid M) :
  (S.to_nat_submodule : set M) = S := rfl

@[simp]
lemma add_submonoid.to_nat_submodule_to_add_submonoid (S : add_submonoid M) :
  S.to_nat_submodule.to_add_submonoid = S :=
add_submonoid.to_nat_submodule.symm_apply_apply S

@[simp]
lemma submodule.to_add_submonoid_to_nat_submodule (S : submodule ℕ M) :
  S.to_add_submonoid.to_nat_submodule = S :=
add_submonoid.to_nat_submodule.apply_symm_apply S

end nat_submodule

end add_comm_monoid

section int_submodule

variables [add_comm_group M]

/-- An additive subgroup is equivalent to a ℤ-submodule. -/
def add_subgroup.to_int_submodule : add_subgroup M ≃o submodule ℤ M :=
{ to_fun := λ S,
  { smul_mem' := λ r s hs, S.zsmul_mem hs _, ..S},
  inv_fun := submodule.to_add_subgroup,
  left_inv := λ ⟨S, _, _, _⟩, rfl,
  right_inv := λ ⟨S, _, _, _⟩, rfl,
  map_rel_iff' := λ a b, iff.rfl }

@[simp]
lemma add_subgroup.to_int_submodule_symm :
  ⇑(add_subgroup.to_int_submodule.symm : _ ≃o add_subgroup M) = submodule.to_add_subgroup := rfl

@[simp]
lemma add_subgroup.coe_to_int_submodule (S : add_subgroup M) :
  (S.to_int_submodule : set M) = S := rfl

@[simp]
lemma add_subgroup.to_int_submodule_to_add_subgroup (S : add_subgroup M) :
  S.to_int_submodule.to_add_subgroup = S :=
add_subgroup.to_int_submodule.symm_apply_apply S

@[simp]
lemma submodule.to_add_subgroup_to_int_submodule (S : submodule ℤ M) :
  S.to_add_subgroup.to_int_submodule = S :=
add_subgroup.to_int_submodule.apply_symm_apply S

end int_submodule


/-
Copyright (c) 2017 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.logic
import Mathlib.Lean3Lib.init.data.ordering.basic

universes u v l

namespace Mathlib

class is_symm_op (α : Type u) (β : outParam (Type v)) (op : α → α → β)
where
  symm_op : ∀ (a b : α), op a b = op b a

class is_commutative (α : Type u) (op : α → α → α)
where
  comm : ∀ (a b : α), op a b = op b a

protected instance is_symm_op_of_is_commutative (α : Type u) (op : α → α → α) [is_commutative α op] : is_symm_op α α op :=
  is_symm_op.mk is_commutative.comm

class is_associative (α : Type u) (op : α → α → α)
where
  assoc : ∀ (a b c : α), op (op a b) c = op a (op b c)

class is_left_id (α : Type u) (op : α → α → α) (o : outParam α)
where
  left_id : ∀ (a : α), op o a = a

class is_right_id (α : Type u) (op : α → α → α) (o : outParam α)
where
  right_id : ∀ (a : α), op a o = a

class is_left_null (α : Type u) (op : α → α → α) (o : outParam α)
where
  left_null : ∀ (a : α), op o a = o

class is_right_null (α : Type u) (op : α → α → α) (o : outParam α)
where
  right_null : ∀ (a : α), op a o = o

class is_left_cancel (α : Type u) (op : α → α → α)
where
  left_cancel : ∀ (a b c : α), op a b = op a c → b = c

class is_right_cancel (α : Type u) (op : α → α → α)
where
  right_cancel : ∀ (a b c : α), op a b = op c b → a = c

class is_idempotent (α : Type u) (op : α → α → α)
where
  idempotent : ∀ (a : α), op a a = a

class is_left_distrib (α : Type u) (op₁ : α → α → α) (op₂ : outParam (α → α → α))
where
  left_distrib : ∀ (a b c : α), op₁ a (op₂ b c) = op₂ (op₁ a b) (op₁ a c)

class is_right_distrib (α : Type u) (op₁ : α → α → α) (op₂ : outParam (α → α → α))
where
  right_distrib : ∀ (a b c : α), op₁ (op₂ a b) c = op₂ (op₁ a c) (op₁ b c)

class is_left_inv (α : Type u) (op : α → α → α) (inv : outParam (α → α)) (o : outParam α)
where
  left_inv : ∀ (a : α), op (inv a) a = o

class is_right_inv (α : Type u) (op : α → α → α) (inv : outParam (α → α)) (o : outParam α)
where
  right_inv : ∀ (a : α), op a (inv a) = o

class is_cond_left_inv (α : Type u) (op : α → α → α) (inv : outParam (α → α)) (o : outParam α) (p : outParam (α → Prop))
where
  left_inv : ∀ (a : α), p a → op (inv a) a = o

class is_cond_right_inv (α : Type u) (op : α → α → α) (inv : outParam (α → α)) (o : outParam α) (p : outParam (α → Prop))
where
  right_inv : ∀ (a : α), p a → op a (inv a) = o

class is_distinct (α : Type u) (a : α) (b : α)
where
  distinct : a ≠ b

/-
-- The following type class doesn't seem very useful, a regular simp lemma should work for this.

-- The following type class doesn't seem very useful, a regular simp lemma should work for this.
class is_inv (α : Type u) (β : Type v) (f : α → β) (g : out β → α) : Prop :=
(inv : ∀ a, g (f a) = a)

-- The following one can also be handled using a regular simp lemma

-- The following one can also be handled using a regular simp lemma
class is_idempotent (α : Type u) (f : α → α) : Prop :=
(idempotent : ∀ a, f (f a) = f a)
-/

/-- `is_irrefl X r` means the binary relation `r` on `X` is irreflexive (that is, `r x x` never
holds). -/
class is_irrefl (α : Type u) (r : α → α → Prop)
where
  irrefl : ∀ (a : α), ¬r a a

/-- `is_refl X r` means the binary relation `r` on `X` is reflexive. -/
class is_refl (α : Type u) (r : α → α → Prop)
where
  refl : ∀ (a : α), r a a

/-- `is_symm X r` means the binary relation `r` on `X` is symmetric. -/
class is_symm (α : Type u) (r : α → α → Prop)
where
  symm : ∀ (a b : α), r a b → r b a

/-- The opposite of a symmetric relation is symmetric. -/
protected instance is_symm_op_of_is_symm (α : Type u) (r : α → α → Prop) [is_symm α r] : is_symm_op α Prop r :=
  is_symm_op.mk fun (a b : α) => propext { mp := is_symm.symm a b, mpr := is_symm.symm b a }

/-- `is_asymm X r` means that the binary relation `r` on `X` is asymmetric, that is,
`r a b → ¬ r b a`. -/
class is_asymm (α : Type u) (r : α → α → Prop)
where
  asymm : ∀ (a b : α), r a b → ¬r b a

/-- `is_antisymm X r` means the binary relation `r` on `X` is antisymmetric. -/
class is_antisymm (α : Type u) (r : α → α → Prop)
where
  antisymm : ∀ (a b : α), r a b → r b a → a = b

/-- `is_trans X r` means the binary relation `r` on `X` is transitive. -/
class is_trans (α : Type u) (r : α → α → Prop)
where
  trans : ∀ (a b c : α), r a b → r b c → r a c

/-- `is_total X r` means that the binary relation `r` on `X` is total, that is, that for any
`x y : X` we have `r x y` or `r y x`.-/
class is_total (α : Type u) (r : α → α → Prop)
where
  total : ∀ (a b : α), r a b ∨ r b a

/-- `is_preorder X r` means that the binary relation `r` on `X` is a pre-order, that is, reflexive
and transitive. -/
class is_preorder (α : Type u) (r : α → α → Prop)
extends is_refl α r, is_trans α r
where

/-- `is_total_preorder X r` means that the binary relation `r` on `X` is total and a preorder. -/
class is_total_preorder (α : Type u) (r : α → α → Prop)
extends is_trans α r, is_total α r
where

/-- Every total pre-order is a pre-order. -/
protected instance is_total_preorder_is_preorder (α : Type u) (r : α → α → Prop) [s : is_total_preorder α r] : is_preorder α r :=
  is_preorder.mk

class is_partial_order (α : Type u) (r : α → α → Prop)
extends is_antisymm α r, is_preorder α r
where

class is_linear_order (α : Type u) (r : α → α → Prop)
extends is_total α r, is_partial_order α r
where

class is_equiv (α : Type u) (r : α → α → Prop)
extends is_symm α r, is_preorder α r
where

class is_per (α : Type u) (r : α → α → Prop)
extends is_symm α r, is_trans α r
where

class is_strict_order (α : Type u) (r : α → α → Prop)
extends is_trans α r, is_irrefl α r
where

class is_incomp_trans (α : Type u) (lt : α → α → Prop)
where
  incomp_trans : ∀ (a b c : α), ¬lt a b ∧ ¬lt b a → ¬lt b c ∧ ¬lt c b → ¬lt a c ∧ ¬lt c a

class is_strict_weak_order (α : Type u) (lt : α → α → Prop)
extends is_incomp_trans α lt, is_strict_order α lt
where

class is_trichotomous (α : Type u) (lt : α → α → Prop)
where
  trichotomous : ∀ (a b : α), lt a b ∨ a = b ∨ lt b a

class is_strict_total_order (α : Type u) (lt : α → α → Prop)
extends is_strict_weak_order α lt, is_trichotomous α lt
where

protected instance eq_is_equiv (α : Type u) : is_equiv α Eq :=
  is_equiv.mk

theorem irrefl {α : Type u} {r : α → α → Prop} [is_irrefl α r] (a : α) : ¬r a a :=
  is_irrefl.irrefl a

theorem refl {α : Type u} {r : α → α → Prop} [is_refl α r] (a : α) : r a a :=
  is_refl.refl a

theorem trans {α : Type u} {r : α → α → Prop} [is_trans α r] {a : α} {b : α} {c : α} : r a b → r b c → r a c :=
  is_trans.trans a b c

theorem symm {α : Type u} {r : α → α → Prop} [is_symm α r] {a : α} {b : α} : r a b → r b a :=
  is_symm.symm a b

theorem antisymm {α : Type u} {r : α → α → Prop} [is_antisymm α r] {a : α} {b : α} : r a b → r b a → a = b :=
  is_antisymm.antisymm a b

theorem asymm {α : Type u} {r : α → α → Prop} [is_asymm α r] {a : α} {b : α} : r a b → ¬r b a :=
  is_asymm.asymm a b

theorem trichotomous {α : Type u} {r : α → α → Prop} [is_trichotomous α r] (a : α) (b : α) : r a b ∨ a = b ∨ r b a :=
  is_trichotomous.trichotomous

theorem incomp_trans {α : Type u} {r : α → α → Prop} [is_incomp_trans α r] {a : α} {b : α} {c : α} : ¬r a b ∧ ¬r b a → ¬r b c ∧ ¬r c b → ¬r a c ∧ ¬r c a :=
  is_incomp_trans.incomp_trans a b c

protected instance is_asymm_of_is_trans_of_is_irrefl {α : Type u} {r : α → α → Prop} [is_trans α r] [is_irrefl α r] : is_asymm α r :=
  is_asymm.mk fun (a b : α) (h₁ : r a b) (h₂ : r b a) => absurd (trans h₁ h₂) (irrefl a)

theorem irrefl_of {α : Type u} (r : α → α → Prop) [is_irrefl α r] (a : α) : ¬r a a :=
  irrefl a

theorem refl_of {α : Type u} (r : α → α → Prop) [is_refl α r] (a : α) : r a a :=
  refl a

theorem trans_of {α : Type u} (r : α → α → Prop) [is_trans α r] {a : α} {b : α} {c : α} : r a b → r b c → r a c :=
  trans

theorem symm_of {α : Type u} (r : α → α → Prop) [is_symm α r] {a : α} {b : α} : r a b → r b a :=
  symm

theorem asymm_of {α : Type u} (r : α → α → Prop) [is_asymm α r] {a : α} {b : α} : r a b → ¬r b a :=
  asymm

theorem total_of {α : Type u} (r : α → α → Prop) [is_total α r] (a : α) (b : α) : r a b ∨ r b a :=
  is_total.total a b

theorem trichotomous_of {α : Type u} (r : α → α → Prop) [is_trichotomous α r] (a : α) (b : α) : r a b ∨ a = b ∨ r b a :=
  trichotomous

theorem incomp_trans_of {α : Type u} (r : α → α → Prop) [is_incomp_trans α r] {a : α} {b : α} {c : α} : ¬r a b ∧ ¬r b a → ¬r b c ∧ ¬r c b → ¬r a c ∧ ¬r c a :=
  incomp_trans

namespace strict_weak_order

def equiv {α : Type u} {r : α → α → Prop} (a : α) (b : α) :=
  ¬r a b ∧ ¬r b a

theorem erefl {α : Type u} {r : α → α → Prop} [is_strict_weak_order α r] (a : α) : equiv a a :=
  { left := irrefl a, right := irrefl a }

theorem esymm {α : Type u} {r : α → α → Prop} [is_strict_weak_order α r] {a : α} {b : α} : equiv a b → equiv b a := sorry

theorem etrans {α : Type u} {r : α → α → Prop} [is_strict_weak_order α r] {a : α} {b : α} {c : α} : equiv a b → equiv b c → equiv a c :=
  incomp_trans

theorem not_lt_of_equiv {α : Type u} {r : α → α → Prop} [is_strict_weak_order α r] {a : α} {b : α} : equiv a b → ¬r a b :=
  fun (h : equiv a b) => and.left h

theorem not_lt_of_equiv' {α : Type u} {r : α → α → Prop} [is_strict_weak_order α r] {a : α} {b : α} : equiv a b → ¬r b a :=
  fun (h : equiv a b) => and.right h

protected instance is_equiv {α : Type u} {r : α → α → Prop} [is_strict_weak_order α r] : is_equiv α equiv :=
  is_equiv.mk

/- Notation for the equivalence relation induced by lt -/

end strict_weak_order

theorem is_strict_weak_order_of_is_total_preorder {α : Type u} {le : α → α → Prop} {lt : α → α → Prop} [DecidableRel le] [s : is_total_preorder α le] (h : ∀ (a b : α), lt a b ↔ ¬le b a) : is_strict_weak_order α lt :=
  is_strict_weak_order.mk

theorem lt_of_lt_of_incomp {α : Type u} {lt : α → α → Prop} [is_strict_weak_order α lt] [DecidableRel lt] {a : α} {b : α} {c : α} : lt a b → ¬lt b c ∧ ¬lt c b → lt a c := sorry

theorem lt_of_incomp_of_lt {α : Type u} {lt : α → α → Prop} [is_strict_weak_order α lt] [DecidableRel lt] {a : α} {b : α} {c : α} : ¬lt a b ∧ ¬lt b a → lt b c → lt a c := sorry

theorem eq_of_incomp {α : Type u} {lt : α → α → Prop} [is_trichotomous α lt] {a : α} {b : α} : ¬lt a b ∧ ¬lt b a → a = b := sorry

theorem eq_of_eqv_lt {α : Type u} {lt : α → α → Prop} [is_trichotomous α lt] {a : α} {b : α} : strict_weak_order.equiv a b → a = b :=
  eq_of_incomp

theorem incomp_iff_eq {α : Type u} {lt : α → α → Prop} [is_trichotomous α lt] [is_irrefl α lt] (a : α) (b : α) : ¬lt a b ∧ ¬lt b a ↔ a = b :=
  { mp := eq_of_incomp, mpr := fun (hab : a = b) => hab ▸ { left := irrefl_of lt a, right := irrefl_of lt a } }

theorem eqv_lt_iff_eq {α : Type u} {lt : α → α → Prop} [is_trichotomous α lt] [is_irrefl α lt] (a : α) (b : α) : strict_weak_order.equiv a b ↔ a = b :=
  incomp_iff_eq a b

theorem not_lt_of_lt {α : Type u} {lt : α → α → Prop} [is_strict_order α lt] {a : α} {b : α} : lt a b → ¬lt b a :=
  fun (h₁ : lt a b) (h₂ : lt b a) => absurd (trans_of lt h₁ h₂) (irrefl_of lt a)


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

! This file was ported from Lean 3 source module category_theory.bicategory.free
! leanprover-community/mathlib commit 3d7987cda72abc473c7cdbbb075170e9ac620042
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.CategoryTheory.Bicategory.Functor

/-!
# Free bicategories

We define the free bicategory over a quiver. In this bicategory, the 1-morphisms are freely
generated by the arrows in the quiver, and the 2-morphisms are freely generated by the formal
identities, the formal unitors, and the formal associators modulo the relation derived from the
axioms of a bicategory.

## Main definitions

* `free_bicategory B`: the free bicategory over a quiver `B`.
* `free_bicategory.lift F`: the pseudofunctor from `free_bicategory B` to `C` associated with a
  prefunctor `F` from `B` to `C`.
-/

universe w w₁ w₂ v v₁ v₂ u u₁ u₂

namespace CategoryTheory

open Category Bicategory

open Bicategory

/-- Free bicategory over a quiver. Its objects are the same as those in the underlying quiver. -/
def FreeBicategory (B : Type u) :=
  B
#align category_theory.free_bicategory CategoryTheory.FreeBicategory

instance (B : Type u) : ∀ [Inhabited B], Inhabited (FreeBicategory B) :=
  id

namespace FreeBicategory

section

variable {B : Type u} [Quiver.{v + 1} B]

/-- 1-morphisms in the free bicategory. -/
inductive Hom : B → B → Type max u v
  | of {a b : B} (f : a ⟶ b) : hom a b
  | id (a : B) : hom a a
  | comp {a b c : B} (f : hom a b) (g : hom b c) : hom a c
#align category_theory.free_bicategory.hom CategoryTheory.FreeBicategory.Hom

instance (a b : B) [Inhabited (a ⟶ b)] : Inhabited (Hom a b) :=
  ⟨Hom.of default⟩

/-- Representatives of 2-morphisms in the free bicategory. -/
@[nolint has_nonempty_instance]
inductive Hom₂ : ∀ {a b : B}, Hom a b → Hom a b → Type max u v
  | id {a b} (f : Hom a b) : hom₂ f f
  | vcomp {a b} {f g h : Hom a b} (η : hom₂ f g) (θ : hom₂ g h) : hom₂ f h
  |
  whisker_left {a b c} (f : Hom a b) {g h : Hom b c} (η : hom₂ g h) :
    hom₂ (f.comp g) (f.comp h)-- `η` cannot be earlier than `h` since it is a recursive argument.

  | whisker_right {a b c} {f g : Hom a b} (h : Hom b c) (η : hom₂ f g) : hom₂ (f.comp h) (g.comp h)
  |
  associator {a b c d} (f : Hom a b) (g : Hom b c) (h : Hom c d) :
    hom₂ ((f.comp g).comp h) (f.comp (g.comp h))
  |
  associator_inv {a b c d} (f : Hom a b) (g : Hom b c) (h : Hom c d) :
    hom₂ (f.comp (g.comp h)) ((f.comp g).comp h)
  | right_unitor {a b} (f : Hom a b) : hom₂ (f.comp (Hom.id b)) f
  | right_unitor_inv {a b} (f : Hom a b) : hom₂ f (f.comp (Hom.id b))
  | left_unitor {a b} (f : Hom a b) : hom₂ ((Hom.id a).comp f) f
  | left_unitor_inv {a b} (f : Hom a b) : hom₂ f ((Hom.id a).comp f)
#align category_theory.free_bicategory.hom₂ CategoryTheory.FreeBicategory.Hom₂

section

variable {B}

-- mathport name: vcomp
-- The following notations are only used in the definition of `rel` to simplify the notation.
local infixr:0 " ≫ " => Hom₂.vcomp

-- mathport name: id
local notation "𝟙" => Hom₂.id

-- mathport name: whisker_left
local notation f " ◁ " η => Hom₂.whisker_left f η

-- mathport name: whisker_right
local notation η " ▷ " h => Hom₂.whisker_right h η

-- mathport name: associator
local notation "α_" => Hom₂.associator

-- mathport name: left_unitor
local notation "λ_" => Hom₂.left_unitor

-- mathport name: right_unitor
local notation "ρ_" => Hom₂.right_unitor

-- mathport name: associator_inv
local notation "α⁻¹_" => Hom₂.associator_inv

-- mathport name: left_unitor_inv
local notation "λ⁻¹_" => Hom₂.left_unitor_inv

-- mathport name: right_unitor_inv
local notation "ρ⁻¹_" => Hom₂.right_unitor_inv

/-- Relations between 2-morphisms in the free bicategory. -/
inductive Rel : ∀ {a b : B} {f g : Hom a b}, Hom₂ f g → Hom₂ f g → Prop
  |
  vcomp_right {a b} {f g h : Hom a b} (η : Hom₂ f g) (θ₁ θ₂ : Hom₂ g h) :
    Rel θ₁ θ₂ → Rel (η ≫ θ₁) (η ≫ θ₂)
  |
  vcomp_left {a b} {f g h : Hom a b} (η₁ η₂ : Hom₂ f g) (θ : Hom₂ g h) :
    Rel η₁ η₂ → Rel (η₁ ≫ θ) (η₂ ≫ θ)
  | id_comp {a b} {f g : Hom a b} (η : Hom₂ f g) : Rel (𝟙 f ≫ η) η
  | comp_id {a b} {f g : Hom a b} (η : Hom₂ f g) : Rel (η ≫ 𝟙 g) η
  |
  assoc {a b} {f g h i : Hom a b} (η : Hom₂ f g) (θ : Hom₂ g h) (ι : Hom₂ h i) :
    Rel ((η ≫ θ) ≫ ι) (η ≫ θ ≫ ι)
  |
  whisker_left {a b c} (f : Hom a b) (g h : Hom b c) (η η' : Hom₂ g h) :
    Rel η η' → Rel (f ◁ η) (f ◁ η')
  | whisker_left_id {a b c} (f : Hom a b) (g : Hom b c) : Rel (f ◁ 𝟙 g) (𝟙 (f.comp g))
  |
  whisker_left_comp {a b c} (f : Hom a b) {g h i : Hom b c} (η : Hom₂ g h) (θ : Hom₂ h i) :
    Rel (f ◁ η ≫ θ) ((f ◁ η) ≫ f ◁ θ)
  | id_whisker_left {a b} {f g : Hom a b} (η : Hom₂ f g) : Rel (Hom.id a ◁ η) (λ_ f ≫ η ≫ λ⁻¹_ g)
  |
  comp_whisker_left {a b c d} (f : Hom a b) (g : Hom b c) {h h' : Hom c d} (η : Hom₂ h h') :
    Rel (f.comp g ◁ η) (α_ f g h ≫ (f ◁ g ◁ η) ≫ α⁻¹_ f g h')
  |
  whisker_right {a b c} (f g : Hom a b) (h : Hom b c) (η η' : Hom₂ f g) :
    Rel η η' → Rel (η ▷ h) (η' ▷ h)
  | id_whisker_right {a b c} (f : Hom a b) (g : Hom b c) : Rel (𝟙 f ▷ g) (𝟙 (f.comp g))
  |
  comp_whisker_right {a b c} {f g h : Hom a b} (i : Hom b c) (η : Hom₂ f g) (θ : Hom₂ g h) :
    Rel ((η ≫ θ) ▷ i) ((η ▷ i) ≫ θ ▷ i)
  | whisker_right_id {a b} {f g : Hom a b} (η : Hom₂ f g) : Rel (η ▷ Hom.id b) (ρ_ f ≫ η ≫ ρ⁻¹_ g)
  |
  whisker_right_comp {a b c d} {f f' : Hom a b} (g : Hom b c) (h : Hom c d) (η : Hom₂ f f') :
    Rel (η ▷ g.comp h) (α⁻¹_ f g h ≫ ((η ▷ g) ▷ h) ≫ α_ f' g h)
  |
  whisker_assoc {a b c d} (f : Hom a b) {g g' : Hom b c} (η : Hom₂ g g') (h : Hom c d) :
    Rel ((f ◁ η) ▷ h) (α_ f g h ≫ (f ◁ η ▷ h) ≫ α⁻¹_ f g' h)
  |
  whisker_exchange {a b c} {f g : Hom a b} {h i : Hom b c} (η : Hom₂ f g) (θ : Hom₂ h i) :
    Rel ((f ◁ θ) ≫ η ▷ i) ((η ▷ h) ≫ g ◁ θ)
  |
  associator_hom_inv {a b c d} (f : Hom a b) (g : Hom b c) (h : Hom c d) :
    Rel (α_ f g h ≫ α⁻¹_ f g h) (𝟙 ((f.comp g).comp h))
  |
  associator_inv_hom {a b c d} (f : Hom a b) (g : Hom b c) (h : Hom c d) :
    Rel (α⁻¹_ f g h ≫ α_ f g h) (𝟙 (f.comp (g.comp h)))
  | left_unitor_hom_inv {a b} (f : Hom a b) : Rel (λ_ f ≫ λ⁻¹_ f) (𝟙 ((Hom.id a).comp f))
  | left_unitor_inv_hom {a b} (f : Hom a b) : Rel (λ⁻¹_ f ≫ λ_ f) (𝟙 f)
  | right_unitor_hom_inv {a b} (f : Hom a b) : Rel (ρ_ f ≫ ρ⁻¹_ f) (𝟙 (f.comp (Hom.id b)))
  | right_unitor_inv_hom {a b} (f : Hom a b) : Rel (ρ⁻¹_ f ≫ ρ_ f) (𝟙 f)
  |
  pentagon {a b c d e} (f : Hom a b) (g : Hom b c) (h : Hom c d) (i : Hom d e) :
    Rel ((α_ f g h ▷ i) ≫ α_ f (g.comp h) i ≫ f ◁ α_ g h i) (α_ (f.comp g) h i ≫ α_ f g (h.comp i))
  | triangle {a b c} (f : Hom a b) (g : Hom b c) : Rel (α_ f (Hom.id b) g ≫ f ◁ λ_ g) (ρ_ f ▷ g)
#align category_theory.free_bicategory.rel CategoryTheory.FreeBicategory.Rel

end

variable {B}

instance homCategory (a b : B) : Category (Hom a b)
    where
  Hom f g := Quot (@Rel _ _ _ _ f g)
  id f := Quot.mk Rel (Hom₂.id f)
  comp f g h := Quot.map₂ Hom₂.vcomp Rel.vcomp_right Rel.vcomp_left
  id_comp' := by
    rintro f g ⟨η⟩
    exact Quot.sound (rel.id_comp η)
  comp_id' := by
    rintro f g ⟨η⟩
    exact Quot.sound (rel.comp_id η)
  assoc' := by
    rintro f g h i ⟨η⟩ ⟨θ⟩ ⟨ι⟩
    exact Quot.sound (rel.assoc η θ ι)
#align category_theory.free_bicategory.hom_category CategoryTheory.FreeBicategory.homCategory

/-- Bicategory structure on the free bicategory. -/
instance bicategory : Bicategory (FreeBicategory B)
    where
  Hom := fun a b : B => Hom a b
  id := Hom.id
  comp a b c := Hom.comp
  homCategory := FreeBicategory.homCategory
  whiskerLeft a b c f g h η := Quot.map (Hom₂.whisker_left f) (Rel.whisker_left f g h) η
  whiskerLeft_id a b c f g := Quot.sound (Rel.whisker_left_id f g)
  whiskerLeft_comp := by
    rintro a b c f g h i ⟨η⟩ ⟨θ⟩
    exact Quot.sound (rel.whisker_left_comp f η θ)
  id_whiskerLeft := by
    rintro a b f g ⟨η⟩
    exact Quot.sound (rel.id_whisker_left η)
  comp_whiskerLeft := by
    rintro a b c d f g h h' ⟨η⟩
    exact Quot.sound (rel.comp_whisker_left f g η)
  whiskerRight a b c f g η h := Quot.map (Hom₂.whisker_right h) (Rel.whisker_right f g h) η
  id_whiskerRight a b c f g := Quot.sound (Rel.id_whisker_right f g)
  comp_whiskerRight := by
    rintro a b c f g h ⟨η⟩ ⟨θ⟩ i
    exact Quot.sound (rel.comp_whisker_right i η θ)
  whiskerRight_id := by
    rintro a b f g ⟨η⟩
    exact Quot.sound (rel.whisker_right_id η)
  whiskerRight_comp := by
    rintro a b c d f f' ⟨η⟩ g h
    exact Quot.sound (rel.whisker_right_comp g h η)
  whisker_assoc := by
    rintro a b c d f g g' ⟨η⟩ h
    exact Quot.sound (rel.whisker_assoc f η h)
  whisker_exchange := by
    rintro a b c f g h i ⟨η⟩ ⟨θ⟩
    exact Quot.sound (rel.whisker_exchange η θ)
  associator a b c d f g h :=
    { Hom := Quot.mk Rel (Hom₂.associator f g h)
      inv := Quot.mk Rel (Hom₂.associator_inv f g h)
      hom_inv_id' := Quot.sound (Rel.associator_hom_inv f g h)
      inv_hom_id' := Quot.sound (Rel.associator_inv_hom f g h) }
  leftUnitor a b f :=
    { Hom := Quot.mk Rel (Hom₂.left_unitor f)
      inv := Quot.mk Rel (Hom₂.left_unitor_inv f)
      hom_inv_id' := Quot.sound (Rel.left_unitor_hom_inv f)
      inv_hom_id' := Quot.sound (Rel.left_unitor_inv_hom f) }
  rightUnitor a b f :=
    { Hom := Quot.mk Rel (Hom₂.right_unitor f)
      inv := Quot.mk Rel (Hom₂.right_unitor_inv f)
      hom_inv_id' := Quot.sound (Rel.right_unitor_hom_inv f)
      inv_hom_id' := Quot.sound (Rel.right_unitor_inv_hom f) }
  pentagon a b c d e f g h i := Quot.sound (Rel.pentagon f g h i)
  triangle a b c f g := Quot.sound (Rel.triangle f g)
#align category_theory.free_bicategory.bicategory CategoryTheory.FreeBicategory.bicategory

variable {a b c d : FreeBicategory B}

@[simp]
theorem mk_vcomp {f g h : a ⟶ b} (η : Hom₂ f g) (θ : Hom₂ g h) :
    Quot.mk Rel (η.vcomp θ) = (Quot.mk Rel η ≫ Quot.mk Rel θ : f ⟶ h) :=
  rfl
#align category_theory.free_bicategory.mk_vcomp CategoryTheory.FreeBicategory.mk_vcomp

@[simp]
theorem mk_whisker_left (f : a ⟶ b) {g h : b ⟶ c} (η : Hom₂ g h) :
    Quot.mk Rel (Hom₂.whisker_left f η) = (f ◁ Quot.mk Rel η : f ≫ g ⟶ f ≫ h) :=
  rfl
#align category_theory.free_bicategory.mk_whisker_left CategoryTheory.FreeBicategory.mk_whisker_left

@[simp]
theorem mk_whisker_right {f g : a ⟶ b} (η : Hom₂ f g) (h : b ⟶ c) :
    Quot.mk Rel (Hom₂.whisker_right h η) = (Quot.mk Rel η ▷ h : f ≫ h ⟶ g ≫ h) :=
  rfl
#align category_theory.free_bicategory.mk_whisker_right CategoryTheory.FreeBicategory.mk_whisker_right

variable (f : a ⟶ b) (g : b ⟶ c) (h : c ⟶ d)

theorem id_def : Hom.id a = 𝟙 a :=
  rfl
#align category_theory.free_bicategory.id_def CategoryTheory.FreeBicategory.id_def

theorem comp_def : Hom.comp f g = f ≫ g :=
  rfl
#align category_theory.free_bicategory.comp_def CategoryTheory.FreeBicategory.comp_def

@[simp]
theorem mk_id : Quot.mk _ (Hom₂.id f) = 𝟙 f :=
  rfl
#align category_theory.free_bicategory.mk_id CategoryTheory.FreeBicategory.mk_id

@[simp]
theorem mk_associator_hom : Quot.mk _ (Hom₂.associator f g h) = (α_ f g h).Hom :=
  rfl
#align category_theory.free_bicategory.mk_associator_hom CategoryTheory.FreeBicategory.mk_associator_hom

@[simp]
theorem mk_associator_inv : Quot.mk _ (Hom₂.associator_inv f g h) = (α_ f g h).inv :=
  rfl
#align category_theory.free_bicategory.mk_associator_inv CategoryTheory.FreeBicategory.mk_associator_inv

@[simp]
theorem mk_left_unitor_hom : Quot.mk _ (Hom₂.left_unitor f) = (λ_ f).Hom :=
  rfl
#align category_theory.free_bicategory.mk_left_unitor_hom CategoryTheory.FreeBicategory.mk_left_unitor_hom

@[simp]
theorem mk_left_unitor_inv : Quot.mk _ (Hom₂.left_unitor_inv f) = (λ_ f).inv :=
  rfl
#align category_theory.free_bicategory.mk_left_unitor_inv CategoryTheory.FreeBicategory.mk_left_unitor_inv

@[simp]
theorem mk_right_unitor_hom : Quot.mk _ (Hom₂.right_unitor f) = (ρ_ f).Hom :=
  rfl
#align category_theory.free_bicategory.mk_right_unitor_hom CategoryTheory.FreeBicategory.mk_right_unitor_hom

@[simp]
theorem mk_right_unitor_inv : Quot.mk _ (Hom₂.right_unitor_inv f) = (ρ_ f).inv :=
  rfl
#align category_theory.free_bicategory.mk_right_unitor_inv CategoryTheory.FreeBicategory.mk_right_unitor_inv

/-- Canonical prefunctor from `B` to `free_bicategory B`. -/
@[simps]
def of : Prefunctor B (FreeBicategory B) where
  obj := id
  map a b := Hom.of
#align category_theory.free_bicategory.of CategoryTheory.FreeBicategory.of

end

section

variable {B : Type u₁} [Quiver.{v₁ + 1} B] {C : Type u₂} [CategoryStruct.{v₂} C]

variable (F : Prefunctor B C)

/- warning: category_theory.free_bicategory.lift_hom -> CategoryTheory.FreeBicategory.liftHom is a dubious translation:
lean 3 declaration is
  forall {B : Type.{u3}} [_inst_1 : Quiver.{succ u1, u3} B] {C : Type.{u4}} [_inst_2 : CategoryTheory.CategoryStruct.{u2, u4} C] (F : Prefunctor.{succ u1, succ u2, u3, u4} B _inst_1 C (CategoryTheory.CategoryStruct.toQuiver.{u2, u4} C _inst_2)) {a : B} {b : B}, (CategoryTheory.FreeBicategory.Hom.{u1, u3} B _inst_1 a b) -> (Quiver.Hom.{succ u2, u4} C (CategoryTheory.CategoryStruct.toQuiver.{u2, u4} C _inst_2) (Prefunctor.obj.{succ u1, succ u2, u3, u4} B _inst_1 C (CategoryTheory.CategoryStruct.toQuiver.{u2, u4} C _inst_2) F a) (Prefunctor.obj.{succ u1, succ u2, u3, u4} B _inst_1 C (CategoryTheory.CategoryStruct.toQuiver.{u2, u4} C _inst_2) F b))
but is expected to have type
  forall {B : Type.{u1}} [_inst_1 : Quiver.{succ u3, u1} B] {C : Type.{u2}} [_inst_2 : CategoryTheory.CategoryStruct.{u4, u2} C] (F : Prefunctor.{succ u3, succ u4, u1, u2} B _inst_1 C (CategoryTheory.CategoryStruct.toQuiver.{u4, u2} C _inst_2)) {a : B} {b : B}, (CategoryTheory.FreeBicategory.Hom.{u3, u1} B _inst_1 a b) -> (Quiver.Hom.{succ u4, u2} C (CategoryTheory.CategoryStruct.toQuiver.{u4, u2} C _inst_2) (Prefunctor.obj.{succ u3, succ u4, u1, u2} B _inst_1 C (CategoryTheory.CategoryStruct.toQuiver.{u4, u2} C _inst_2) F a) (Prefunctor.obj.{succ u3, succ u4, u1, u2} B _inst_1 C (CategoryTheory.CategoryStruct.toQuiver.{u4, u2} C _inst_2) F b))
Case conversion may be inaccurate. Consider using '#align category_theory.free_bicategory.lift_hom CategoryTheory.FreeBicategory.liftHomₓ'. -/
/-- Auxiliary definition for `lift`. -/
@[simp]
def liftHom : ∀ {a b : B}, Hom a b → (F.obj a ⟶ F.obj b)
  | _, _, hom.of f => F.map f
  | _, _, hom.id a => 𝟙 (F.obj a)
  | _, _, hom.comp f g => lift_hom f ≫ lift_hom g
#align category_theory.free_bicategory.lift_hom CategoryTheory.FreeBicategory.liftHom

@[simp]
theorem liftHom_id (a : FreeBicategory B) : liftHom F (𝟙 a) = 𝟙 (F.obj a) :=
  rfl
#align category_theory.free_bicategory.lift_hom_id CategoryTheory.FreeBicategory.liftHom_id

@[simp]
theorem liftHom_comp {a b c : FreeBicategory B} (f : a ⟶ b) (g : b ⟶ c) :
    liftHom F (f ≫ g) = liftHom F f ≫ liftHom F g :=
  rfl
#align category_theory.free_bicategory.lift_hom_comp CategoryTheory.FreeBicategory.liftHom_comp

end

section

variable {B : Type u₁} [Quiver.{v₁ + 1} B] {C : Type u₂} [Bicategory.{w₂, v₂} C]

variable (F : Prefunctor B C)

/- warning: category_theory.free_bicategory.lift_hom₂ -> CategoryTheory.FreeBicategory.liftHom₂ is a dubious translation:
lean 3 declaration is
  forall {B : Type.{u4}} [_inst_1 : Quiver.{succ u2, u4} B] {C : Type.{u5}} [_inst_2 : CategoryTheory.Bicategory.{u1, u3, u5} C] (F : Prefunctor.{succ u2, succ u3, u4, u5} B _inst_1 C (CategoryTheory.CategoryStruct.toQuiver.{u3, u5} C (CategoryTheory.Bicategory.toCategoryStruct.{u1, u3, u5} C _inst_2))) {a : B} {b : B} {f : CategoryTheory.FreeBicategory.Hom.{u2, u4} B _inst_1 a b} {g : CategoryTheory.FreeBicategory.Hom.{u2, u4} B _inst_1 a b}, (CategoryTheory.FreeBicategory.Hom₂.{u2, u4} B _inst_1 a b f g) -> (Quiver.Hom.{succ u1, u3} (Quiver.Hom.{succ u3, u5} C (CategoryTheory.CategoryStruct.toQuiver.{u3, u5} C (CategoryTheory.Bicategory.toCategoryStruct.{u1, u3, u5} C _inst_2)) (Prefunctor.obj.{succ u2, succ u3, u4, u5} B _inst_1 C (CategoryTheory.CategoryStruct.toQuiver.{u3, u5} C (CategoryTheory.Bicategory.toCategoryStruct.{u1, u3, u5} C _inst_2)) F a) (Prefunctor.obj.{succ u2, succ u3, u4, u5} B _inst_1 C (CategoryTheory.CategoryStruct.toQuiver.{u3, u5} C (CategoryTheory.Bicategory.toCategoryStruct.{u1, u3, u5} C _inst_2)) F b)) (CategoryTheory.CategoryStruct.toQuiver.{u1, u3} (Quiver.Hom.{succ u3, u5} C (CategoryTheory.CategoryStruct.toQuiver.{u3, u5} C (CategoryTheory.Bicategory.toCategoryStruct.{u1, u3, u5} C _inst_2)) (Prefunctor.obj.{succ u2, succ u3, u4, u5} B _inst_1 C (CategoryTheory.CategoryStruct.toQuiver.{u3, u5} C (CategoryTheory.Bicategory.toCategoryStruct.{u1, u3, u5} C _inst_2)) F a) (Prefunctor.obj.{succ u2, succ u3, u4, u5} B _inst_1 C (CategoryTheory.CategoryStruct.toQuiver.{u3, u5} C (CategoryTheory.Bicategory.toCategoryStruct.{u1, u3, u5} C _inst_2)) F b)) (CategoryTheory.Category.toCategoryStruct.{u1, u3} (Quiver.Hom.{succ u3, u5} C (CategoryTheory.CategoryStruct.toQuiver.{u3, u5} C (CategoryTheory.Bicategory.toCategoryStruct.{u1, u3, u5} C _inst_2)) (Prefunctor.obj.{succ u2, succ u3, u4, u5} B _inst_1 C (CategoryTheory.CategoryStruct.toQuiver.{u3, u5} C (CategoryTheory.Bicategory.toCategoryStruct.{u1, u3, u5} C _inst_2)) F a) (Prefunctor.obj.{succ u2, succ u3, u4, u5} B _inst_1 C (CategoryTheory.CategoryStruct.toQuiver.{u3, u5} C (CategoryTheory.Bicategory.toCategoryStruct.{u1, u3, u5} C _inst_2)) F b)) (CategoryTheory.Bicategory.homCategory.{u1, u3, u5} C _inst_2 (Prefunctor.obj.{succ u2, succ u3, u4, u5} B _inst_1 C (CategoryTheory.CategoryStruct.toQuiver.{u3, u5} C (CategoryTheory.Bicategory.toCategoryStruct.{u1, u3, u5} C _inst_2)) F a) (Prefunctor.obj.{succ u2, succ u3, u4, u5} B _inst_1 C (CategoryTheory.CategoryStruct.toQuiver.{u3, u5} C (CategoryTheory.Bicategory.toCategoryStruct.{u1, u3, u5} C _inst_2)) F b)))) (CategoryTheory.FreeBicategory.liftHom.{u2, u3, u4, u5} B _inst_1 C (CategoryTheory.Bicategory.toCategoryStruct.{u1, u3, u5} C _inst_2) F a b f) (CategoryTheory.FreeBicategory.liftHom.{u2, u3, u4, u5} B _inst_1 C (CategoryTheory.Bicategory.toCategoryStruct.{u1, u3, u5} C _inst_2) F a b g))
but is expected to have type
  PUnit.{max (max (max (max (succ (succ u1)) (succ (succ u2))) (succ (succ u3))) (succ (succ u4))) (succ (succ u5))}
Case conversion may be inaccurate. Consider using '#align category_theory.free_bicategory.lift_hom₂ CategoryTheory.FreeBicategory.liftHom₂ₓ'. -/
/-- Auxiliary definition for `lift`. -/
@[simp]
def liftHom₂ : ∀ {a b : B} {f g : Hom a b}, Hom₂ f g → (liftHom F f ⟶ liftHom F g)
  | _, _, _, _, hom₂.id _ => 𝟙 _
  | _, _, _, _, hom₂.associator _ _ _ => (α_ _ _ _).Hom
  | _, _, _, _, hom₂.associator_inv _ _ _ => (α_ _ _ _).inv
  | _, _, _, _, hom₂.left_unitor _ => (λ_ _).Hom
  | _, _, _, _, hom₂.left_unitor_inv _ => (λ_ _).inv
  | _, _, _, _, hom₂.right_unitor _ => (ρ_ _).Hom
  | _, _, _, _, hom₂.right_unitor_inv _ => (ρ_ _).inv
  | _, _, _, _, hom₂.vcomp η θ => lift_hom₂ η ≫ lift_hom₂ θ
  | _, _, _, _, hom₂.whisker_left f η => liftHom F f ◁ lift_hom₂ η
  | _, _, _, _, hom₂.whisker_right h η => lift_hom₂ η ▷ liftHom F h
#align category_theory.free_bicategory.lift_hom₂ CategoryTheory.FreeBicategory.liftHom₂

attribute [local simp] whisker_exchange

theorem liftHom₂_congr {a b : B} {f g : Hom a b} {η θ : Hom₂ f g} (H : Rel η θ) :
    liftHom₂ F η = liftHom₂ F θ := by induction H <;> tidy
#align category_theory.free_bicategory.lift_hom₂_congr CategoryTheory.FreeBicategory.liftHom₂_congr

/-- A prefunctor from a quiver `B` to a bicategory `C` can be lifted to a pseudofunctor from
`free_bicategory B` to `C`.
-/
@[simps]
def lift : Pseudofunctor (FreeBicategory B) C
    where
  obj := F.obj
  map a b := liftHom F
  zipWith a b f g := Quot.lift (liftHom₂ F) fun η θ H => liftHom₂_congr F H
  map_id a := Iso.refl _
  map_comp a b c f g := Iso.refl _
#align category_theory.free_bicategory.lift CategoryTheory.FreeBicategory.lift

end

end FreeBicategory

end CategoryTheory


set_option pp.analyze false

def p (x y : Nat) := x = y

example (x y : Nat) : p (x + y) (y + x + 0) := by
  conv =>
    whnf
    congr
    . skip
    . whnf; skip
  trace_state
  rw [Nat.add_comm]
  rfl

example (x y : Nat) : p (x + y) (y + x + 0) := by
  conv =>
    whnf
    rhs
    whnf
  trace_state
  rw [Nat.add_comm]
  rfl

example (x y : Nat) : p (x + y) (y + x + 0) := by
  conv =>
    whnf
    lhs
    whnf
  conv =>
    rhs
    whnf
  trace_state
  apply Nat.add_comm x y

example (x y : Nat) : p (x + y) (0 + y + x) := by
  conv =>
    whnf
    rhs
    rw [Nat.zero_add, Nat.add_comm]
    trace_state
    skip
    done

axiom div_self (x : Nat) : x ≠ 0 → x / x = 1

example (h : x ≠ 0) : x / x + x = x.succ := by
  conv =>
    lhs
    arg 1
    rw [div_self]
    skip
    tactic => assumption
    done
  show 1 + x = x.succ
  rw [Nat.succ_add, Nat.zero_add]

example (h1 : x ≠ 0) (h2 : y = x / x) : y = 1 := by
  conv at h2 =>
    rhs
    rw [div_self]
    skip
    tactic => assumption
  assumption

example : id (fun x => 0 + x) = id := by
  conv =>
    lhs
    arg 1
    ext y
    rw [Nat.zero_add]

def f (x : Nat) :=
  if x > 0 then
    x + 1
  else
    x + 2

example (g : Nat → Nat) (h₁ : g x = x + 1) (h₂ : x > 0) : g x = f x := by
  conv =>
    rhs
    simp [f, h₂]
  exact h₁

example (h₁ : f x = x + 1) (h₂ : x > 0) : f x = f x := by
  conv =>
    rhs
    simp [f, h₂]
  exact h₁

example (x y : Nat) (f : Nat → Nat → Nat) (g : Nat → Nat) (h₁ : ∀ z, f z z = z) (h₂ : ∀ x y, f (g x) (g y) = y) : f (g (0 + y)) (f (g x) (g (x + 0))) = x := by
  conv in _ + 0 => apply Nat.add_zero
  trace_state
  conv in 0 + _ => apply Nat.zero_add
  trace_state
  simp [h₁, h₂]

example (x y : Nat) (f : Nat → Nat → Nat) (g : Nat → Nat)
        (h₁ : ∀ z, f z z = z) (h₂ : ∀ x y, f (g x) (g y) = y)
        (h₃ : f (g (0 + x)) (g x) = 0)
 : g x = 0 := by
  conv at h₃ in 0 + x => apply Nat.zero_add
  trace_state
  conv at h₃ => lhs; apply h₁
  trace_state
  assumption


/-
Copyright (c) 2020 Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bhavik Mehta

! This file was ported from Lean 3 source module category_theory.essential_image
! leanprover-community/mathlib commit c3291da49cfa65f0d43b094750541c0731edc932
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.CategoryTheory.NaturalIsomorphism
import Mathbin.CategoryTheory.FullSubcategory

/-!
# Essential image of a functor

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

The essential image `ess_image` of a functor consists of the objects in the target category which
are isomorphic to an object in the image of the object function.
This, for instance, allows us to talk about objects belonging to a subcategory expressed as a
functor rather than a subtype, preserving the principle of equivalence. For example this lets us
define exponential ideals.

The essential image can also be seen as a subcategory of the target category, and witnesses that
a functor decomposes into a essentially surjective functor and a fully faithful functor.
(TODO: show that this decomposition forms an orthogonal factorisation system).
-/

universe v₁ v₂ u₁ u₂

noncomputable section

namespace CategoryTheory

variable {C : Type u₁} {D : Type u₂} [Category.{v₁} C] [Category.{v₂} D] {F : C ⥤ D}

namespace Functor

#print CategoryTheory.Functor.essImage /-
/-- The essential image of a functor `F` consists of those objects in the target category which are
isomorphic to an object in the image of the function `F.obj`. In other words, this is the closure
under isomorphism of the function `F.obj`.
This is the "non-evil" way of describing the image of a functor.
-/
def essImage (F : C ⥤ D) : Set D := fun Y => ∃ X : C, Nonempty (F.obj X ≅ Y)
#align category_theory.functor.ess_image CategoryTheory.Functor.essImage
-/

#print CategoryTheory.Functor.essImage.witness /-
/-- Get the witnessing object that `Y` is in the subcategory given by `F`. -/
def essImage.witness {Y : D} (h : Y ∈ F.essImage) : C :=
  h.some
#align category_theory.functor.ess_image.witness CategoryTheory.Functor.essImage.witness
-/

/- warning: category_theory.functor.ess_image.get_iso -> CategoryTheory.Functor.essImage.getIso is a dubious translation:
lean 3 declaration is
  forall {C : Type.{u3}} {D : Type.{u4}} [_inst_1 : CategoryTheory.Category.{u1, u3} C] [_inst_2 : CategoryTheory.Category.{u2, u4} D] {F : CategoryTheory.Functor.{u1, u2, u3, u4} C _inst_1 D _inst_2} {Y : D} (h : Membership.Mem.{u4, u4} D (Set.{u4} D) (Set.hasMem.{u4} D) Y (CategoryTheory.Functor.essImage.{u1, u2, u3, u4} C D _inst_1 _inst_2 F)), CategoryTheory.Iso.{u2, u4} D _inst_2 (CategoryTheory.Functor.obj.{u1, u2, u3, u4} C _inst_1 D _inst_2 F (CategoryTheory.Functor.essImage.witness.{u1, u2, u3, u4} C D _inst_1 _inst_2 F Y h)) Y
but is expected to have type
  forall {C : Type.{u3}} {D : Type.{u4}} [_inst_1 : CategoryTheory.Category.{u1, u3} C] [_inst_2 : CategoryTheory.Category.{u2, u4} D] {F : CategoryTheory.Functor.{u1, u2, u3, u4} C _inst_1 D _inst_2} {Y : D} (h : Membership.mem.{u4, u4} D (Set.{u4} D) (Set.instMembershipSet.{u4} D) Y (CategoryTheory.Functor.essImage.{u1, u2, u3, u4} C D _inst_1 _inst_2 F)), CategoryTheory.Iso.{u2, u4} D _inst_2 (Prefunctor.obj.{succ u1, succ u2, u3, u4} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u3} C (CategoryTheory.Category.toCategoryStruct.{u1, u3} C _inst_1)) D (CategoryTheory.CategoryStruct.toQuiver.{u2, u4} D (CategoryTheory.Category.toCategoryStruct.{u2, u4} D _inst_2)) (CategoryTheory.Functor.toPrefunctor.{u1, u2, u3, u4} C _inst_1 D _inst_2 F) (CategoryTheory.Functor.essImage.witness.{u1, u2, u3, u4} C D _inst_1 _inst_2 F Y h)) Y
Case conversion may be inaccurate. Consider using '#align category_theory.functor.ess_image.get_iso CategoryTheory.Functor.essImage.getIsoₓ'. -/
/-- Extract the isomorphism between `F.obj h.witness` and `Y` itself. -/
def essImage.getIso {Y : D} (h : Y ∈ F.essImage) : F.obj h.witness ≅ Y :=
  Classical.choice h.choose_spec
#align category_theory.functor.ess_image.get_iso CategoryTheory.Functor.essImage.getIso

#print CategoryTheory.Functor.essImage.ofIso /-
/-- Being in the essential image is a "hygenic" property: it is preserved under isomorphism. -/
theorem essImage.ofIso {Y Y' : D} (h : Y ≅ Y') (hY : Y ∈ essImage F) : Y' ∈ essImage F :=
  hY.imp fun B => Nonempty.map (· ≪≫ h)
#align category_theory.functor.ess_image.of_iso CategoryTheory.Functor.essImage.ofIso
-/

#print CategoryTheory.Functor.essImage.ofNatIso /-
/-- If `Y` is in the essential image of `F` then it is in the essential image of `F'` as long as
`F ≅ F'`.
-/
theorem essImage.ofNatIso {F' : C ⥤ D} (h : F ≅ F') {Y : D} (hY : Y ∈ essImage F) :
    Y ∈ essImage F' :=
  hY.imp fun X => Nonempty.map fun t => h.symm.app X ≪≫ t
#align category_theory.functor.ess_image.of_nat_iso CategoryTheory.Functor.essImage.ofNatIso
-/

#print CategoryTheory.Functor.essImage_eq_of_natIso /-
/-- Isomorphic functors have equal essential images. -/
theorem essImage_eq_of_natIso {F' : C ⥤ D} (h : F ≅ F') : essImage F = essImage F' :=
  funext fun _ => propext ⟨essImage.ofNatIso h, essImage.ofNatIso h.symm⟩
#align category_theory.functor.ess_image_eq_of_nat_iso CategoryTheory.Functor.essImage_eq_of_natIso
-/

/- warning: category_theory.functor.obj_mem_ess_image -> CategoryTheory.Functor.obj_mem_essImage is a dubious translation:
lean 3 declaration is
  forall {C : Type.{u3}} {D : Type.{u4}} [_inst_1 : CategoryTheory.Category.{u1, u3} C] [_inst_2 : CategoryTheory.Category.{u2, u4} D] (F : CategoryTheory.Functor.{u2, u1, u4, u3} D _inst_2 C _inst_1) (Y : D), Membership.Mem.{u3, u3} C (Set.{u3} C) (Set.hasMem.{u3} C) (CategoryTheory.Functor.obj.{u2, u1, u4, u3} D _inst_2 C _inst_1 F Y) (CategoryTheory.Functor.essImage.{u2, u1, u4, u3} D C _inst_2 _inst_1 F)
but is expected to have type
  forall {C : Type.{u3}} {D : Type.{u4}} [_inst_1 : CategoryTheory.Category.{u1, u3} C] [_inst_2 : CategoryTheory.Category.{u2, u4} D] (F : CategoryTheory.Functor.{u2, u1, u4, u3} D _inst_2 C _inst_1) (Y : D), Membership.mem.{u3, u3} C (Set.{u3} C) (Set.instMembershipSet.{u3} C) (Prefunctor.obj.{succ u2, succ u1, u4, u3} D (CategoryTheory.CategoryStruct.toQuiver.{u2, u4} D (CategoryTheory.Category.toCategoryStruct.{u2, u4} D _inst_2)) C (CategoryTheory.CategoryStruct.toQuiver.{u1, u3} C (CategoryTheory.Category.toCategoryStruct.{u1, u3} C _inst_1)) (CategoryTheory.Functor.toPrefunctor.{u2, u1, u4, u3} D _inst_2 C _inst_1 F) Y) (CategoryTheory.Functor.essImage.{u2, u1, u4, u3} D C _inst_2 _inst_1 F)
Case conversion may be inaccurate. Consider using '#align category_theory.functor.obj_mem_ess_image CategoryTheory.Functor.obj_mem_essImageₓ'. -/
/-- An object in the image is in the essential image. -/
theorem obj_mem_essImage (F : D ⥤ C) (Y : D) : F.obj Y ∈ essImage F :=
  ⟨Y, ⟨Iso.refl _⟩⟩
#align category_theory.functor.obj_mem_ess_image CategoryTheory.Functor.obj_mem_essImage

#print CategoryTheory.Functor.EssImageSubcategory /-
/-- The essential image of a functor, interpreted of a full subcategory of the target category. -/
@[nolint has_nonempty_instance]
def EssImageSubcategory (F : C ⥤ D) :=
  FullSubcategory F.essImage deriving Category
#align category_theory.functor.ess_image_subcategory CategoryTheory.Functor.EssImageSubcategory
-/

#print CategoryTheory.Functor.essImageInclusion /-
/-- The essential image as a subcategory has a fully faithful inclusion into the target category. -/
@[simps]
def essImageInclusion (F : C ⥤ D) : F.EssImageSubcategory ⥤ D :=
  fullSubcategoryInclusion _ deriving Full, Faithful
#align category_theory.functor.ess_image_inclusion CategoryTheory.Functor.essImageInclusion
-/

#print CategoryTheory.Functor.toEssImage /-
/--
Given a functor `F : C ⥤ D`, we have an (essentially surjective) functor from `C` to the essential
image of `F`.
-/
@[simps]
def toEssImage (F : C ⥤ D) : C ⥤ F.EssImageSubcategory :=
  FullSubcategory.lift _ F (obj_mem_essImage _)
#align category_theory.functor.to_ess_image CategoryTheory.Functor.toEssImage
-/

#print CategoryTheory.Functor.toEssImageCompEssentialImageInclusion /-
/-- The functor `F` factorises through its essential image, where the first functor is essentially
surjective and the second is fully faithful.
-/
@[simps]
def toEssImageCompEssentialImageInclusion (F : C ⥤ D) : F.toEssImage ⋙ F.essImageInclusion ≅ F :=
  FullSubcategory.lift_comp_inclusion _ _ _
#align category_theory.functor.to_ess_image_comp_essential_image_inclusion CategoryTheory.Functor.toEssImageCompEssentialImageInclusion
-/

end Functor

#print CategoryTheory.EssSurj /-
/- ./././Mathport/Syntax/Translate/Command.lean:388:30: infer kinds are unsupported in Lean 4: #[`mem_essImage] [] -/
/-- A functor `F : C ⥤ D` is essentially surjective if every object of `D` is in the essential image
of `F`. In other words, for every `Y : D`, there is some `X : C` with `F.obj X ≅ Y`.

See <https://stacks.math.columbia.edu/tag/001C>.
-/
class EssSurj (F : C ⥤ D) : Prop where
  mem_essImage (Y : D) : Y ∈ F.essImage
#align category_theory.ess_surj CategoryTheory.EssSurj
-/

instance : EssSurj F.toEssImage
    where mem_essImage := fun ⟨Y, hY⟩ => ⟨_, ⟨⟨_, _, hY.getIso.hom_inv_id, hY.getIso.inv_hom_id⟩⟩⟩

variable (F) [EssSurj F]

#print CategoryTheory.Functor.objPreimage /-
/-- Given an essentially surjective functor, we can find a preimage for every object `Y` in the
    codomain. Applying the functor to this preimage will yield an object isomorphic to `Y`, see
    `obj_obj_preimage_iso`. -/
def Functor.objPreimage (Y : D) : C :=
  (EssSurj.mem_essImage F Y).witness
#align category_theory.functor.obj_preimage CategoryTheory.Functor.objPreimage
-/

/- warning: category_theory.functor.obj_obj_preimage_iso -> CategoryTheory.Functor.objObjPreimageIso is a dubious translation:
lean 3 declaration is
  forall {C : Type.{u3}} {D : Type.{u4}} [_inst_1 : CategoryTheory.Category.{u1, u3} C] [_inst_2 : CategoryTheory.Category.{u2, u4} D] (F : CategoryTheory.Functor.{u1, u2, u3, u4} C _inst_1 D _inst_2) [_inst_3 : CategoryTheory.EssSurj.{u1, u2, u3, u4} C D _inst_1 _inst_2 F] (Y : D), CategoryTheory.Iso.{u2, u4} D _inst_2 (CategoryTheory.Functor.obj.{u1, u2, u3, u4} C _inst_1 D _inst_2 F (CategoryTheory.Functor.objPreimage.{u1, u2, u3, u4} C D _inst_1 _inst_2 F _inst_3 Y)) Y
but is expected to have type
  forall {C : Type.{u3}} {D : Type.{u4}} [_inst_1 : CategoryTheory.Category.{u1, u3} C] [_inst_2 : CategoryTheory.Category.{u2, u4} D] (F : CategoryTheory.Functor.{u1, u2, u3, u4} C _inst_1 D _inst_2) [_inst_3 : CategoryTheory.EssSurj.{u1, u2, u3, u4} C D _inst_1 _inst_2 F] (Y : D), CategoryTheory.Iso.{u2, u4} D _inst_2 (Prefunctor.obj.{succ u1, succ u2, u3, u4} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u3} C (CategoryTheory.Category.toCategoryStruct.{u1, u3} C _inst_1)) D (CategoryTheory.CategoryStruct.toQuiver.{u2, u4} D (CategoryTheory.Category.toCategoryStruct.{u2, u4} D _inst_2)) (CategoryTheory.Functor.toPrefunctor.{u1, u2, u3, u4} C _inst_1 D _inst_2 F) (CategoryTheory.Functor.objPreimage.{u1, u2, u3, u4} C D _inst_1 _inst_2 F _inst_3 Y)) Y
Case conversion may be inaccurate. Consider using '#align category_theory.functor.obj_obj_preimage_iso CategoryTheory.Functor.objObjPreimageIsoₓ'. -/
/-- Applying an essentially surjective functor to a preimage of `Y` yields an object that is
    isomorphic to `Y`. -/
def Functor.objObjPreimageIso (Y : D) : F.obj (F.objPreimage Y) ≅ Y :=
  (EssSurj.mem_essImage F Y).getIso
#align category_theory.functor.obj_obj_preimage_iso CategoryTheory.Functor.objObjPreimageIso

#print CategoryTheory.Faithful.toEssImage /-
/-- The induced functor of a faithful functor is faithful -/
instance Faithful.toEssImage (F : C ⥤ D) [Faithful F] : Faithful F.toEssImage :=
  Faithful.of_comp_iso F.toEssImageCompEssentialImageInclusion
#align category_theory.faithful.to_ess_image CategoryTheory.Faithful.toEssImage
-/

#print CategoryTheory.Full.toEssImage /-
/-- The induced functor of a full functor is full -/
instance Full.toEssImage (F : C ⥤ D) [Full F] : Full F.toEssImage :=
  haveI := full.of_iso F.to_ess_image_comp_essential_image_inclusion.symm
  full.of_comp_faithful F.to_ess_image F.ess_image_inclusion
#align category_theory.full.to_ess_image CategoryTheory.Full.toEssImage
-/

end CategoryTheory


variables (α : Type) (p q : α → Prop)
variable r : Prop

example : α → ((∀ x : α, r) ↔ r) :=
assume y: α,
⟨
  assume h: ∀ x: α, r,
  h y,

  λ hr: r, λ _, hr
⟩

example : (∀ x, p x ∨ r) ↔ (∀ x, p x) ∨ r := ⟨
  assume h: (∀ x, p x ∨ r),
  show (∀ x, p x) ∨ r, from classical.by_contradiction (
    assume hc: ¬ ((∀ x, p x) ∨ r),
    classical.by_cases (
      assume hr: r,
      hc $ or.inr hr
    ) (
      assume hnr: ¬ r,
      have hpx: ∀ x, p x, from
      λ x, or.elim (h x) (
        λ px: p x, px
      ) (
        λ hr: r,
        absurd hr hnr
      ),
      hc $ or.inl hpx
    )
  ),

  assume h: (∀ x, p x) ∨ r,
  or.elim h (
    λ hpx, λ x, or.inl $ hpx x
  ) (
    λ hr, λ x, or.inr hr
  )
⟩

example : (∀ x, r → p x) ↔ (r → ∀ x, p x) := ⟨
  assume h: ∀ x, r → p x,
  λ hr, λ x, h x hr,

  assume h: r → ∀ x, p x,
  λ x, λ hr, h hr x
⟩