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

! This file was ported from Lean 3 source module data.int.dvd.basic
! leanprover-community/mathlib commit e1bccd6e40ae78370f01659715d3c948716e3b7e
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Int.Order.Basic
import Mathbin.Data.Nat.Cast.Basic

/-!
# Basic lemmas about the divisibility relation in `ℤ`.

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

open Nat

namespace Int

/- warning: int.coe_nat_dvd -> Int.coe_nat_dvd is a dubious translation:
lean 3 declaration is
  forall {m : Nat} {n : Nat}, Iff (Dvd.Dvd.{0} Int (semigroupDvd.{0} Int Int.semigroup) ((fun (a : Type) (b : Type) [self : HasLiftT.{1, 1} a b] => self.0) Nat Int (HasLiftT.mk.{1, 1} Nat Int (CoeTCₓ.coe.{1, 1} Nat Int (coeBase.{1, 1} Nat Int Int.hasCoe))) m) ((fun (a : Type) (b : Type) [self : HasLiftT.{1, 1} a b] => self.0) Nat Int (HasLiftT.mk.{1, 1} Nat Int (CoeTCₓ.coe.{1, 1} Nat Int (coeBase.{1, 1} Nat Int Int.hasCoe))) n)) (Dvd.Dvd.{0} Nat Nat.hasDvd m n)
but is expected to have type
  forall {m : Nat} {n : Nat}, Iff (Dvd.dvd.{0} Int Int.instDvdInt (Nat.cast.{0} Int instNatCastInt m) (Nat.cast.{0} Int instNatCastInt n)) (Dvd.dvd.{0} Nat Nat.instDvdNat m n)
Case conversion may be inaccurate. Consider using '#align int.coe_nat_dvd Int.coe_nat_dvdₓ'. -/
@[norm_cast]
theorem coe_nat_dvd {m n : ℕ} : (↑m : ℤ) ∣ ↑n ↔ m ∣ n :=
  ⟨fun ⟨a, ae⟩ =>
    m.eq_zero_or_pos.elim (fun m0 => by simp [m0] at ae <;> simp [ae, m0]) fun m0l =>
      by
      cases'
        eq_coe_of_zero_le
          (@nonneg_of_mul_nonneg_right ℤ _ m a (by simp [ae.symm]) (by simpa using m0l)) with
        k e
      subst a
      exact ⟨k, Int.ofNat.inj ae⟩,
    fun ⟨k, e⟩ => Dvd.intro k <| by rw [e, Int.ofNat_mul]⟩
#align int.coe_nat_dvd Int.coe_nat_dvd

/- warning: int.coe_nat_dvd_left -> Int.coe_nat_dvd_left is a dubious translation:
lean 3 declaration is
  forall {n : Nat} {z : Int}, Iff (Dvd.Dvd.{0} Int (semigroupDvd.{0} Int Int.semigroup) ((fun (a : Type) (b : Type) [self : HasLiftT.{1, 1} a b] => self.0) Nat Int (HasLiftT.mk.{1, 1} Nat Int (CoeTCₓ.coe.{1, 1} Nat Int (coeBase.{1, 1} Nat Int Int.hasCoe))) n) z) (Dvd.Dvd.{0} Nat Nat.hasDvd n (Int.natAbs z))
but is expected to have type
  forall {n : Nat} {z : Int}, Iff (Dvd.dvd.{0} Int Int.instDvdInt (Nat.cast.{0} Int instNatCastInt n) z) (Dvd.dvd.{0} Nat Nat.instDvdNat n (Int.natAbs z))
Case conversion may be inaccurate. Consider using '#align int.coe_nat_dvd_left Int.coe_nat_dvd_leftₓ'. -/
theorem coe_nat_dvd_left {n : ℕ} {z : ℤ} : (↑n : ℤ) ∣ z ↔ n ∣ z.natAbs := by
  rcases nat_abs_eq z with (eq | eq) <;> rw [Eq] <;> simp [← coe_nat_dvd]
#align int.coe_nat_dvd_left Int.coe_nat_dvd_left

/- warning: int.coe_nat_dvd_right -> Int.coe_nat_dvd_right is a dubious translation:
lean 3 declaration is
  forall {n : Nat} {z : Int}, Iff (Dvd.Dvd.{0} Int (semigroupDvd.{0} Int Int.semigroup) z ((fun (a : Type) (b : Type) [self : HasLiftT.{1, 1} a b] => self.0) Nat Int (HasLiftT.mk.{1, 1} Nat Int (CoeTCₓ.coe.{1, 1} Nat Int (coeBase.{1, 1} Nat Int Int.hasCoe))) n)) (Dvd.Dvd.{0} Nat Nat.hasDvd (Int.natAbs z) n)
but is expected to have type
  forall {n : Nat} {z : Int}, Iff (Dvd.dvd.{0} Int Int.instDvdInt z (Nat.cast.{0} Int instNatCastInt n)) (Dvd.dvd.{0} Nat Nat.instDvdNat (Int.natAbs z) n)
Case conversion may be inaccurate. Consider using '#align int.coe_nat_dvd_right Int.coe_nat_dvd_rightₓ'. -/
theorem coe_nat_dvd_right {n : ℕ} {z : ℤ} : z ∣ (↑n : ℤ) ↔ z.natAbs ∣ n := by
  rcases nat_abs_eq z with (eq | eq) <;> rw [Eq] <;> simp [← coe_nat_dvd]
#align int.coe_nat_dvd_right Int.coe_nat_dvd_right

/- warning: int.le_of_dvd -> Int.le_of_dvd is a dubious translation:
lean 3 declaration is
  forall {a : Int} {b : Int}, (LT.lt.{0} Int Int.hasLt (OfNat.ofNat.{0} Int 0 (OfNat.mk.{0} Int 0 (Zero.zero.{0} Int Int.hasZero))) b) -> (Dvd.Dvd.{0} Int (semigroupDvd.{0} Int Int.semigroup) a b) -> (LE.le.{0} Int Int.hasLe a b)
but is expected to have type
  forall {a : Int} {b : Int}, (LT.lt.{0} Int Int.instLTInt (OfNat.ofNat.{0} Int 0 (instOfNatInt 0)) b) -> (Dvd.dvd.{0} Int Int.instDvdInt a b) -> (LE.le.{0} Int Int.instLEInt a b)
Case conversion may be inaccurate. Consider using '#align int.le_of_dvd Int.le_of_dvdₓ'. -/
theorem le_of_dvd {a b : ℤ} (bpos : 0 < b) (H : a ∣ b) : a ≤ b :=
  match a, b, eq_succ_of_zero_lt bpos, H with
  | (m : ℕ), _, ⟨n, rfl⟩, H => ofNat_le_ofNat_of_le <| Nat.le_of_dvd n.succ_pos <| coe_nat_dvd.1 H
  | -[m+1], _, ⟨n, rfl⟩, _ => le_trans (le_of_lt <| negSucc_lt_zero _) (ofNat_zero_le _)
#align int.le_of_dvd Int.le_of_dvd

/- warning: int.eq_one_of_dvd_one -> Int.eq_one_of_dvd_one is a dubious translation:
lean 3 declaration is
  forall {a : Int}, (LE.le.{0} Int Int.hasLe (OfNat.ofNat.{0} Int 0 (OfNat.mk.{0} Int 0 (Zero.zero.{0} Int Int.hasZero))) a) -> (Dvd.Dvd.{0} Int (semigroupDvd.{0} Int Int.semigroup) a (OfNat.ofNat.{0} Int 1 (OfNat.mk.{0} Int 1 (One.one.{0} Int Int.hasOne)))) -> (Eq.{1} Int a (OfNat.ofNat.{0} Int 1 (OfNat.mk.{0} Int 1 (One.one.{0} Int Int.hasOne))))
but is expected to have type
  forall {a : Int}, (LE.le.{0} Int Int.instLEInt (OfNat.ofNat.{0} Int 0 (instOfNatInt 0)) a) -> (Dvd.dvd.{0} Int Int.instDvdInt a (OfNat.ofNat.{0} Int 1 (instOfNatInt 1))) -> (Eq.{1} Int a (OfNat.ofNat.{0} Int 1 (instOfNatInt 1)))
Case conversion may be inaccurate. Consider using '#align int.eq_one_of_dvd_one Int.eq_one_of_dvd_oneₓ'. -/
theorem eq_one_of_dvd_one {a : ℤ} (H : 0 ≤ a) (H' : a ∣ 1) : a = 1 :=
  match a, eq_ofNat_of_zero_le H, H' with
  | _, ⟨n, rfl⟩, H' => congr_arg coe <| Nat.eq_one_of_dvd_one <| coe_nat_dvd.1 H'
#align int.eq_one_of_dvd_one Int.eq_one_of_dvd_one

#print Int.eq_one_of_mul_eq_one_right /-
theorem eq_one_of_mul_eq_one_right {a b : ℤ} (H : 0 ≤ a) (H' : a * b = 1) : a = 1 :=
  eq_one_of_dvd_one H ⟨b, H'.symm⟩
#align int.eq_one_of_mul_eq_one_right Int.eq_one_of_mul_eq_one_right
-/

#print Int.eq_one_of_mul_eq_one_left /-
theorem eq_one_of_mul_eq_one_left {a b : ℤ} (H : 0 ≤ b) (H' : a * b = 1) : b = 1 :=
  eq_one_of_mul_eq_one_right H (by rw [mul_comm, H'])
#align int.eq_one_of_mul_eq_one_left Int.eq_one_of_mul_eq_one_left
-/

/- warning: int.of_nat_dvd_of_dvd_nat_abs -> Int.ofNat_dvd_of_dvd_natAbs is a dubious translation:
lean 3 declaration is
  forall {a : Nat} {z : Int}, (Dvd.Dvd.{0} Nat Nat.hasDvd a (Int.natAbs z)) -> (Dvd.Dvd.{0} Int (semigroupDvd.{0} Int Int.semigroup) ((fun (a : Type) (b : Type) [self : HasLiftT.{1, 1} a b] => self.0) Nat Int (HasLiftT.mk.{1, 1} Nat Int (CoeTCₓ.coe.{1, 1} Nat Int (coeBase.{1, 1} Nat Int Int.hasCoe))) a) z)
but is expected to have type
  forall {a : Nat} {z : Int}, (Dvd.dvd.{0} Nat Nat.instDvdNat a (Int.natAbs z)) -> (Dvd.dvd.{0} Int Int.instDvdInt (Nat.cast.{0} Int instNatCastInt a) z)
Case conversion may be inaccurate. Consider using '#align int.of_nat_dvd_of_dvd_nat_abs Int.ofNat_dvd_of_dvd_natAbsₓ'. -/
theorem ofNat_dvd_of_dvd_natAbs {a : ℕ} : ∀ {z : ℤ} (haz : a ∣ z.natAbs), ↑a ∣ z
  | Int.ofNat _, haz => Int.coe_nat_dvd.2 haz
  | -[k+1], haz => by
    change ↑a ∣ -(k + 1 : ℤ)
    apply dvd_neg_of_dvd
    apply Int.coe_nat_dvd.2
    exact haz
#align int.of_nat_dvd_of_dvd_nat_abs Int.ofNat_dvd_of_dvd_natAbs

/- warning: int.dvd_nat_abs_of_of_nat_dvd -> Int.dvd_natAbs_of_ofNat_dvd is a dubious translation:
lean 3 declaration is
  forall {a : Nat} {z : Int}, (Dvd.Dvd.{0} Int (semigroupDvd.{0} Int Int.semigroup) ((fun (a : Type) (b : Type) [self : HasLiftT.{1, 1} a b] => self.0) Nat Int (HasLiftT.mk.{1, 1} Nat Int (CoeTCₓ.coe.{1, 1} Nat Int (coeBase.{1, 1} Nat Int Int.hasCoe))) a) z) -> (Dvd.Dvd.{0} Nat Nat.hasDvd a (Int.natAbs z))
but is expected to have type
  forall {a : Nat} {z : Int}, (Dvd.dvd.{0} Int Int.instDvdInt (Nat.cast.{0} Int instNatCastInt a) z) -> (Dvd.dvd.{0} Nat Nat.instDvdNat a (Int.natAbs z))
Case conversion may be inaccurate. Consider using '#align int.dvd_nat_abs_of_of_nat_dvd Int.dvd_natAbs_of_ofNat_dvdₓ'. -/
theorem dvd_natAbs_of_ofNat_dvd {a : ℕ} : ∀ {z : ℤ} (haz : ↑a ∣ z), a ∣ z.natAbs
  | Int.ofNat _, haz => Int.coe_nat_dvd.1 (Int.dvd_natAbs.2 haz)
  | -[k+1], haz =>
    have haz' : (↑a : ℤ) ∣ (↑(k + 1) : ℤ) := dvd_of_dvd_neg haz
    Int.coe_nat_dvd.1 haz'
#align int.dvd_nat_abs_of_of_nat_dvd Int.dvd_natAbs_of_ofNat_dvd

/- warning: int.dvd_antisymm -> Int.dvd_antisymm is a dubious translation:
lean 3 declaration is
  forall {a : Int} {b : Int}, (LE.le.{0} Int Int.hasLe (OfNat.ofNat.{0} Int 0 (OfNat.mk.{0} Int 0 (Zero.zero.{0} Int Int.hasZero))) a) -> (LE.le.{0} Int Int.hasLe (OfNat.ofNat.{0} Int 0 (OfNat.mk.{0} Int 0 (Zero.zero.{0} Int Int.hasZero))) b) -> (Dvd.Dvd.{0} Int (semigroupDvd.{0} Int Int.semigroup) a b) -> (Dvd.Dvd.{0} Int (semigroupDvd.{0} Int Int.semigroup) b a) -> (Eq.{1} Int a b)
but is expected to have type
  forall {a : Int} {b : Int}, (LE.le.{0} Int Int.instLEInt (OfNat.ofNat.{0} Int 0 (instOfNatInt 0)) a) -> (LE.le.{0} Int Int.instLEInt (OfNat.ofNat.{0} Int 0 (instOfNatInt 0)) b) -> (Dvd.dvd.{0} Int Int.instDvdInt a b) -> (Dvd.dvd.{0} Int Int.instDvdInt b a) -> (Eq.{1} Int a b)
Case conversion may be inaccurate. Consider using '#align int.dvd_antisymm Int.dvd_antisymmₓ'. -/
theorem dvd_antisymm {a b : ℤ} (H1 : 0 ≤ a) (H2 : 0 ≤ b) : a ∣ b → b ∣ a → a = b :=
  by
  rw [← abs_of_nonneg H1, ← abs_of_nonneg H2, abs_eq_nat_abs, abs_eq_nat_abs]
  rw [coe_nat_dvd, coe_nat_dvd, coe_nat_inj']
  apply Nat.dvd_antisymm
#align int.dvd_antisymm Int.dvd_antisymm

end Int


/-
Copyright (c) 2020 Simon Hudon. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Simon Hudon
-/
import control.random
import control.uliftable

/-!
# `gen` Monad

This monad is used to formulate randomized computations with a parameter
to specify the desired size of the result.

This is a port of the Haskell QuickCheck library.

## Main definitions
  * `gen` monad

## Local notation

 * `i .. j` : `Icc i j`, the set of values between `i` and `j` inclusively;

## Tags

random testing

## References

  * https://hackage.haskell.org/package/QuickCheck

-/

universes u v

namespace slim_check

/-- Monad to generate random examples to test properties with.
It has a `nat` parameter so that the caller can decide on the
size of the examples. -/
@[reducible, derive [monad, is_lawful_monad]]
def gen (α : Type u) := reader_t (ulift ℕ) rand α

variable (α : Type u)

local infix ` .. `:41 := set.Icc

/-- Execute a `gen` inside the `io` monad using `i` as the example
size and with a fresh random number generator. -/
def io.run_gen {α} (x : gen α) (i : ℕ) : io α :=
io.run_rand (x.run ⟨i⟩)

namespace gen

section rand

/-- Lift `random.random` to the `gen` monad. -/
def choose_any [random α] : gen α :=
⟨ λ _, rand.random α ⟩

variables {α} [preorder α]

/-- Lift `random.random_r` to the `gen` monad. -/
def choose [bounded_random α] (x y : α) (p : x ≤ y) : gen (x .. y) :=
⟨ λ _, rand.random_r x y p ⟩

end rand

open nat (hiding choose)

/-- Generate a `nat` example between `x` and `y`. -/
def choose_nat (x y : ℕ) (p : x ≤ y) : gen (x .. y) :=
choose x y p

/-- Generate a `nat` example between `x` and `y`. -/
def choose_nat' (x y : ℕ) (p : x < y) : gen (set.Ico x y) :=
have ∀ i, x < i → i ≤ y → i.pred < y,
  from λ i h₀ h₁,
     show i.pred.succ ≤ y,
     by rwa succ_pred_eq_of_pos; apply lt_of_le_of_lt (nat.zero_le _) h₀,
subtype.map pred (λ i (h : x+1 ≤ i ∧ i ≤ y), ⟨le_pred_of_lt h.1, this _ h.1 h.2⟩) <$>
  choose (x+1) y p

open nat

instance : uliftable gen.{u} gen.{v} :=
reader_t.uliftable' (equiv.ulift.trans equiv.ulift.symm)

instance : has_orelse gen.{u} :=
⟨ λ α x y, do
  b ← uliftable.up $ choose_any bool,
  if b.down then x else y ⟩

variable {α}

/-- Get access to the size parameter of the `gen` monad. For
reasons of universe polymorphism, it is specified in
continuation passing style. -/
def sized (cmd : ℕ → gen α) : gen α :=
⟨ λ ⟨sz⟩, reader_t.run (cmd sz) ⟨sz⟩ ⟩

/-- Apply a function to the size parameter. -/
def resize (f : ℕ → ℕ) (cmd : gen α) : gen α :=
⟨ λ ⟨sz⟩, reader_t.run cmd ⟨f sz⟩ ⟩

/-- Create `n` examples using `cmd`. -/
def vector_of : ∀ (n : ℕ) (cmd : gen α), gen (vector α n)
| 0 _ := return vector.nil
| (succ n) cmd := vector.cons <$> cmd <*> vector_of n cmd

/-- Create a list of examples using `cmd`. The size is controlled
by the size parameter of `gen`. -/
def list_of (cmd : gen α) : gen (list α) :=
sized $ λ sz, do
do ⟨ n ⟩ ← uliftable.up $ choose_nat 0 (sz + 1) dec_trivial,
   v ← vector_of n.val cmd,
   return v.to_list

open ulift

/-- Given a list of example generators, choose one to create an example. -/
def one_of (xs : list (gen α)) (pos : 0 < xs.length) : gen α := do
⟨⟨n, h, h'⟩⟩ ← uliftable.up $ choose_nat' 0 xs.length pos,
list.nth_le xs n h'

/-- Given a list of example generators, choose one to create an example. -/
def elements (xs : list α) (pos : 0 < xs.length) : gen α := do
⟨⟨n,h₀,h₁⟩⟩ ← uliftable.up $ choose_nat' 0 xs.length pos,
pure $ list.nth_le xs n h₁

/--
`freq_aux xs i _` takes a weighted list of generator and a number meant to select one of the
generators.

If we consider `freq_aux [(1, gena), (3, genb), (5, genc)] 4 _`, we choose a generator by splitting
the interval 1-9 into 1-1, 2-4, 5-9 so that the width of each interval corresponds to one of the
number in the list of generators. Then, we check which interval 4 falls into: it selects `genb`.
-/
def freq_aux : Π (xs : list (ℕ+ × gen α)) i, i < (xs.map (subtype.val ∘ prod.fst)).sum → gen α
| [] i h := false.elim (nat.not_lt_zero _ h)
| ((i, x) :: xs) j h :=
  if h' : j < i then x
  else freq_aux xs (j - i)
    (by { rw tsub_lt_iff_right (le_of_not_gt h'),
      simpa [list.sum_cons, add_comm] using h })

/--
`freq [(1, gena), (3, genb), (5, genc)] _` will choose one of `gena`, `genb`, `genc` with
probabilities proportional to the number accompanying them. In this example, the sum of
those numbers is 9, `gena` will be chosen with probability ~1/9, `genb` with ~3/9 (i.e. 1/3)
and `genc` with probability 5/9.
-/
def freq (xs : list (ℕ+ × gen α)) (pos : 0 < xs.length) : gen α :=
let s := (xs.map (subtype.val ∘ prod.fst)).sum in
have ha : 1 ≤ s, from
  (le_trans pos $
    list.length_map (subtype.val ∘ prod.fst) xs ▸
      (list.length_le_sum_of_one_le _ (λ i, by { simp, intros, assumption }))),
have 0 ≤ s - 1, from le_tsub_of_add_le_right ha,
uliftable.adapt_up gen.{0} gen.{u} (choose_nat 0 (s-1) this) $ λ i,
freq_aux xs i.1 (by rcases i with ⟨i,h₀,h₁⟩; rwa le_tsub_iff_right at h₁; exact ha)

/-- Generate a random permutation of a given list. -/
def permutation_of {α : Type u} : Π xs : list α, gen (subtype $ list.perm xs)
| [] := pure ⟨[], list.perm.nil ⟩
| (x :: xs) := do
⟨xs',h⟩ ← permutation_of xs,
⟨⟨n,_,h'⟩⟩ ← uliftable.up $ choose_nat 0 xs'.length dec_trivial,
pure ⟨list.insert_nth n x xs',
  list.perm.trans (list.perm.cons _ h)
    (list.perm_insert_nth _ _ h').symm ⟩

end gen

end slim_check


lemma and_symm (P Q : Prop) : P ∧ Q → Q ∧ P :=
begin
intro h,
cases h with p q,
split,
exact q,
exact p,
end


/-
Copyright (c) 2020 Aaron Anderson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Aaron Anderson
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.finset.fold
import Mathlib.data.multiset.gcd
import Mathlib.PostPort

universes u_1 u_2

namespace Mathlib

/-!
# GCD and LCM operations on finsets

## Main definitions

- `finset.gcd` - the greatest common denominator of a `finset` of elements of a `gcd_monoid`
- `finset.lcm` - the least common multiple of a `finset` of elements of a `gcd_monoid`

## Implementation notes

Many of the proofs use the lemmas `gcd.def` and `lcm.def`, which relate `finset.gcd`
and `finset.lcm` to `multiset.gcd` and `multiset.lcm`.

TODO: simplify with a tactic and `data.finset.lattice`

## Tags

finset, gcd
-/

namespace finset

/-! ### lcm -/

/-- Least common multiple of a finite set -/
def lcm {α : Type u_1} {β : Type u_2} [comm_cancel_monoid_with_zero α] [nontrivial α] [gcd_monoid α]
    (s : finset β) (f : β → α) : α :=
  fold lcm 1 f s

theorem lcm_def {α : Type u_1} {β : Type u_2} [comm_cancel_monoid_with_zero α] [nontrivial α]
    [gcd_monoid α] {s : finset β} {f : β → α} : lcm s f = multiset.lcm (multiset.map f (val s)) :=
  rfl

@[simp] theorem lcm_empty {α : Type u_1} {β : Type u_2} [comm_cancel_monoid_with_zero α]
    [nontrivial α] [gcd_monoid α] {f : β → α} : lcm ∅ f = 1 :=
  fold_empty

@[simp] theorem lcm_dvd_iff {α : Type u_1} {β : Type u_2} [comm_cancel_monoid_with_zero α]
    [nontrivial α] [gcd_monoid α] {s : finset β} {f : β → α} {a : α} :
    lcm s f ∣ a ↔ ∀ (b : β), b ∈ s → f b ∣ a :=
  sorry

theorem lcm_dvd {α : Type u_1} {β : Type u_2} [comm_cancel_monoid_with_zero α] [nontrivial α]
    [gcd_monoid α] {s : finset β} {f : β → α} {a : α} :
    (∀ (b : β), b ∈ s → f b ∣ a) → lcm s f ∣ a :=
  iff.mpr lcm_dvd_iff

theorem dvd_lcm {α : Type u_1} {β : Type u_2} [comm_cancel_monoid_with_zero α] [nontrivial α]
    [gcd_monoid α] {s : finset β} {f : β → α} {b : β} (hb : b ∈ s) : f b ∣ lcm s f :=
  iff.mp lcm_dvd_iff (dvd_refl (lcm s f)) b hb

@[simp] theorem lcm_insert {α : Type u_1} {β : Type u_2} [comm_cancel_monoid_with_zero α]
    [nontrivial α] [gcd_monoid α] {s : finset β} {f : β → α} [DecidableEq β] {b : β} :
    lcm (insert b s) f = lcm (f b) (lcm s f) :=
  sorry

@[simp] theorem lcm_singleton {α : Type u_1} {β : Type u_2} [comm_cancel_monoid_with_zero α]
    [nontrivial α] [gcd_monoid α] {f : β → α} {b : β} :
    lcm (singleton b) f = coe_fn normalize (f b) :=
  multiset.lcm_singleton

@[simp] theorem normalize_lcm {α : Type u_1} {β : Type u_2} [comm_cancel_monoid_with_zero α]
    [nontrivial α] [gcd_monoid α] {s : finset β} {f : β → α} :
    coe_fn normalize (lcm s f) = lcm s f :=
  sorry

theorem lcm_union {α : Type u_1} {β : Type u_2} [comm_cancel_monoid_with_zero α] [nontrivial α]
    [gcd_monoid α] {s₁ : finset β} {s₂ : finset β} {f : β → α} [DecidableEq β] :
    lcm (s₁ ∪ s₂) f = lcm (lcm s₁ f) (lcm s₂ f) :=
  sorry

theorem lcm_congr {α : Type u_1} {β : Type u_2} [comm_cancel_monoid_with_zero α] [nontrivial α]
    [gcd_monoid α] {s₁ : finset β} {s₂ : finset β} {f : β → α} {g : β → α} (hs : s₁ = s₂)
    (hfg : ∀ (a : β), a ∈ s₂ → f a = g a) : lcm s₁ f = lcm s₂ g :=
  Eq._oldrec (fun (hfg : ∀ (a : β), a ∈ s₁ → f a = g a) => fold_congr hfg) hs hfg

theorem lcm_mono_fun {α : Type u_1} {β : Type u_2} [comm_cancel_monoid_with_zero α] [nontrivial α]
    [gcd_monoid α] {s : finset β} {f : β → α} {g : β → α} (h : ∀ (b : β), b ∈ s → f b ∣ g b) :
    lcm s f ∣ lcm s g :=
  lcm_dvd fun (b : β) (hb : b ∈ s) => dvd_trans (h b hb) (dvd_lcm hb)

theorem lcm_mono {α : Type u_1} {β : Type u_2} [comm_cancel_monoid_with_zero α] [nontrivial α]
    [gcd_monoid α] {s₁ : finset β} {s₂ : finset β} {f : β → α} (h : s₁ ⊆ s₂) :
    lcm s₁ f ∣ lcm s₂ f :=
  lcm_dvd fun (b : β) (hb : b ∈ s₁) => dvd_lcm (h hb)

/-! ### gcd -/

/-- Greatest common divisor of a finite set -/
def gcd {α : Type u_1} {β : Type u_2} [comm_cancel_monoid_with_zero α] [nontrivial α] [gcd_monoid α]
    (s : finset β) (f : β → α) : α :=
  fold gcd 0 f s

theorem gcd_def {α : Type u_1} {β : Type u_2} [comm_cancel_monoid_with_zero α] [nontrivial α]
    [gcd_monoid α] {s : finset β} {f : β → α} : gcd s f = multiset.gcd (multiset.map f (val s)) :=
  rfl

@[simp] theorem gcd_empty {α : Type u_1} {β : Type u_2} [comm_cancel_monoid_with_zero α]
    [nontrivial α] [gcd_monoid α] {f : β → α} : gcd ∅ f = 0 :=
  fold_empty

theorem dvd_gcd_iff {α : Type u_1} {β : Type u_2} [comm_cancel_monoid_with_zero α] [nontrivial α]
    [gcd_monoid α] {s : finset β} {f : β → α} {a : α} : a ∣ gcd s f ↔ ∀ (b : β), b ∈ s → a ∣ f b :=
  sorry

theorem gcd_dvd {α : Type u_1} {β : Type u_2} [comm_cancel_monoid_with_zero α] [nontrivial α]
    [gcd_monoid α] {s : finset β} {f : β → α} {b : β} (hb : b ∈ s) : gcd s f ∣ f b :=
  iff.mp dvd_gcd_iff (dvd_refl (gcd s f)) b hb

theorem dvd_gcd {α : Type u_1} {β : Type u_2} [comm_cancel_monoid_with_zero α] [nontrivial α]
    [gcd_monoid α] {s : finset β} {f : β → α} {a : α} :
    (∀ (b : β), b ∈ s → a ∣ f b) → a ∣ gcd s f :=
  iff.mpr dvd_gcd_iff

@[simp] theorem gcd_insert {α : Type u_1} {β : Type u_2} [comm_cancel_monoid_with_zero α]
    [nontrivial α] [gcd_monoid α] {s : finset β} {f : β → α} [DecidableEq β] {b : β} :
    gcd (insert b s) f = gcd (f b) (gcd s f) :=
  sorry

@[simp] theorem gcd_singleton {α : Type u_1} {β : Type u_2} [comm_cancel_monoid_with_zero α]
    [nontrivial α] [gcd_monoid α] {f : β → α} {b : β} :
    gcd (singleton b) f = coe_fn normalize (f b) :=
  multiset.gcd_singleton

@[simp] theorem normalize_gcd {α : Type u_1} {β : Type u_2} [comm_cancel_monoid_with_zero α]
    [nontrivial α] [gcd_monoid α] {s : finset β} {f : β → α} :
    coe_fn normalize (gcd s f) = gcd s f :=
  sorry

theorem gcd_union {α : Type u_1} {β : Type u_2} [comm_cancel_monoid_with_zero α] [nontrivial α]
    [gcd_monoid α] {s₁ : finset β} {s₂ : finset β} {f : β → α} [DecidableEq β] :
    gcd (s₁ ∪ s₂) f = gcd (gcd s₁ f) (gcd s₂ f) :=
  sorry

theorem gcd_congr {α : Type u_1} {β : Type u_2} [comm_cancel_monoid_with_zero α] [nontrivial α]
    [gcd_monoid α] {s₁ : finset β} {s₂ : finset β} {f : β → α} {g : β → α} (hs : s₁ = s₂)
    (hfg : ∀ (a : β), a ∈ s₂ → f a = g a) : gcd s₁ f = gcd s₂ g :=
  Eq._oldrec (fun (hfg : ∀ (a : β), a ∈ s₁ → f a = g a) => fold_congr hfg) hs hfg

theorem gcd_mono_fun {α : Type u_1} {β : Type u_2} [comm_cancel_monoid_with_zero α] [nontrivial α]
    [gcd_monoid α] {s : finset β} {f : β → α} {g : β → α} (h : ∀ (b : β), b ∈ s → f b ∣ g b) :
    gcd s f ∣ gcd s g :=
  dvd_gcd fun (b : β) (hb : b ∈ s) => dvd_trans (gcd_dvd hb) (h b hb)

theorem gcd_mono {α : Type u_1} {β : Type u_2} [comm_cancel_monoid_with_zero α] [nontrivial α]
    [gcd_monoid α] {s₁ : finset β} {s₂ : finset β} {f : β → α} (h : s₁ ⊆ s₂) :
    gcd s₂ f ∣ gcd s₁ f :=
  dvd_gcd fun (b : β) (hb : b ∈ s₁) => gcd_dvd (h hb)

theorem gcd_eq_zero_iff {α : Type u_1} {β : Type u_2} [comm_cancel_monoid_with_zero α]
    [nontrivial α] [gcd_monoid α] {s : finset β} {f : β → α} :
    gcd s f = 0 ↔ ∀ (x : β), x ∈ s → f x = 0 :=
  sorry

theorem gcd_eq_gcd_filter_ne_zero {α : Type u_1} {β : Type u_2} [comm_cancel_monoid_with_zero α]
    [nontrivial α] [gcd_monoid α] {s : finset β} {f : β → α}
    [decidable_pred fun (x : β) => f x = 0] : gcd s f = gcd (filter (fun (x : β) => f x ≠ 0) s) f :=
  sorry

theorem gcd_mul_left {α : Type u_1} {β : Type u_2} [comm_cancel_monoid_with_zero α] [nontrivial α]
    [gcd_monoid α] {s : finset β} {f : β → α} {a : α} :
    (gcd s fun (x : β) => a * f x) = coe_fn normalize a * gcd s f :=
  sorry

theorem gcd_mul_right {α : Type u_1} {β : Type u_2} [comm_cancel_monoid_with_zero α] [nontrivial α]
    [gcd_monoid α] {s : finset β} {f : β → α} {a : α} :
    (gcd s fun (x : β) => f x * a) = gcd s f * coe_fn normalize a :=
  sorry

end finset

namespace finset

theorem gcd_eq_of_dvd_sub {α : Type u_1} {β : Type u_2} [nontrivial β] [integral_domain α]
    [gcd_monoid α] {s : finset β} {f : β → α} {g : β → α} {a : α}
    (h : ∀ (x : β), x ∈ s → a ∣ f x - g x) : gcd a (gcd s f) = gcd a (gcd s g) :=
  sorry

end Mathlib


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

/-!
# Functors which reflect isomorphisms

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

A functor `F` reflects isomorphisms if whenever `F.map f` is an isomorphism, `f` was too.

It is formalized as a `Prop` valued typeclass `reflects_isomorphisms F`.

Any fully faithful functor reflects isomorphisms.
-/

open category_theory category_theory.functor

namespace category_theory

universes v₁ v₂ v₃ u₁ u₂ u₃

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

section reflects_iso
variables {D : Type u₂} [category.{v₂} D]
variables {E : Type u₃} [category.{v₃} E]

/--
Define what it means for a functor `F : C ⥤ D` to reflect isomorphisms: for any
morphism `f : A ⟶ B`, if `F.map f` is an isomorphism then `f` is as well.
Note that we do not assume or require that `F` is faithful.
-/
class reflects_isomorphisms (F : C ⥤ D) : Prop :=
(reflects : Π {A B : C} (f : A ⟶ B) [is_iso (F.map f)], is_iso f)

/-- If `F` reflects isos and `F.map f` is an iso, then `f` is an iso. -/
lemma is_iso_of_reflects_iso {A B : C} (f : A ⟶ B) (F : C ⥤ D)
  [is_iso (F.map f)] [reflects_isomorphisms F] :
  is_iso f :=
reflects_isomorphisms.reflects F f

@[priority 100]
instance of_full_and_faithful (F : C ⥤ D) [full F] [faithful F] : reflects_isomorphisms F :=
{ reflects := λ X Y f i, by exactI
  ⟨⟨F.preimage (inv (F.map f)), ⟨F.map_injective (by simp), F.map_injective (by simp)⟩⟩⟩ }

instance (F : C ⥤ D) (G : D ⥤ E) [reflects_isomorphisms F] [reflects_isomorphisms G] :
  reflects_isomorphisms (F ⋙ G) :=
⟨λ _ _ f (hf : is_iso (G.map _)),
  by { resetI, haveI := is_iso_of_reflects_iso (F.map f) G, exact is_iso_of_reflects_iso f F }⟩

@[priority 100]
instance reflects_isomorphisms_of_reflects_monomorphisms_of_reflects_epimorphisms [balanced C]
  (F : C ⥤ D) [reflects_monomorphisms F] [reflects_epimorphisms F] : reflects_isomorphisms F :=
{ reflects := λ A B f hf,
  begin
    resetI,
    haveI : epi f := epi_of_epi_map F infer_instance,
    haveI : mono f := mono_of_mono_map F infer_instance,
    exact is_iso_of_mono_of_epi f
  end }

end reflects_iso

end category_theory


/-
Copyright (c) 2017 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Stephen Morgan, Scott Morrison
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.category_theory.products.basic
import Mathlib.PostPort

universes v₁ v₂ v₃ u₁ u₂ u₃

namespace Mathlib

namespace category_theory.bifunctor

@[simp] theorem map_id {C : Type u₁} {D : Type u₂} {E : Type u₃} [category C] [category D]
    [category E] (F : C × D ⥤ E) (X : C) (Y : D) : functor.map F (𝟙, 𝟙) = 𝟙 :=
  functor.map_id F (X, Y)

@[simp] theorem map_id_comp {C : Type u₁} {D : Type u₂} {E : Type u₃} [category C] [category D]
    [category E] (F : C × D ⥤ E) (W : C) {X : D} {Y : D} {Z : D} (f : X ⟶ Y) (g : Y ⟶ Z) :
    functor.map F (𝟙, f ≫ g) = functor.map F (𝟙, f) ≫ functor.map F (𝟙, g) :=
  sorry

@[simp] theorem map_comp_id {C : Type u₁} {D : Type u₂} {E : Type u₃} [category C] [category D]
    [category E] (F : C × D ⥤ E) (X : C) (Y : C) (Z : C) (W : D) (f : X ⟶ Y) (g : Y ⟶ Z) :
    functor.map F (f ≫ g, 𝟙) = functor.map F (f, 𝟙) ≫ functor.map F (g, 𝟙) :=
  sorry

@[simp] theorem diagonal {C : Type u₁} {D : Type u₂} {E : Type u₃} [category C] [category D]
    [category E] (F : C × D ⥤ E) (X : C) (X' : C) (f : X ⟶ X') (Y : D) (Y' : D) (g : Y ⟶ Y') :
    functor.map F (𝟙, g) ≫ functor.map F (f, 𝟙) = functor.map F (f, g) :=
  sorry

@[simp] theorem diagonal' {C : Type u₁} {D : Type u₂} {E : Type u₃} [category C] [category D]
    [category E] (F : C × D ⥤ E) (X : C) (X' : C) (f : X ⟶ X') (Y : D) (Y' : D) (g : Y ⟶ Y') :
    functor.map F (f, 𝟙) ≫ functor.map F (𝟙, g) = functor.map F (f, g) :=
  sorry

end Mathlib


/-
Copyright (c) 2016 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Mario Carneiro
-/
import Mathlib.Logic.Basic
import Mathlib.Init.Data.Nat.Lemmas
import Mathlib.Init.Function
import Mathlib.Init.Set
import Mathlib.Init.SetNotation
import Mathlib.Tactic.Lint.Basic

universe u v w

namespace Function

section
variable {α β γ : Sort _} {f : α → β}

/-- Evaluate a function at an argument. Useful if you want to talk about the partially applied
  `Function.eval x : (∀ x, β x) → β x`. -/
@[reducible, simp] def eval {β : α → Sort _} (x : α) (f : ∀ x, β x) : β x := f x

lemma const_def {y : β} : (λ x : α => y) = const α y := rfl

@[simp] lemma const_comp {f : α → β} {c : γ} : const β c ∘ f = const α c := rfl

@[simp] lemma comp_const {f : β → γ} {b : β} : f ∘ const α b = const α (f b) := rfl

lemma id_def : @id α = λ x => x := rfl

lemma hfunext {α α': Sort u} {β : α → Sort v} {β' : α' → Sort v} {f : ∀a, β a} {f' : ∀a, β' a}
  (hα : α = α') (h : ∀a a', HEq a a' → HEq (f a) (f' a')) : HEq f f' := by
  subst hα
  have : ∀a, HEq (f a) (f' a) := λ a => h a a (HEq.refl a)
  have : β = β' := by funext a
                      exact type_eq_of_heq (this a)
  subst this
  apply heq_of_eq
  funext a
  exact eq_of_heq (this a)

lemma funext_iff {β : α → Sort _} {f₁ f₂ : ∀ (x : α), β x} : f₁ = f₂ ↔ (∀a, f₁ a = f₂ a) :=
Iff.intro (λ h a => h ▸ rfl) funext

protected lemma bijective.injective {f : α → β} (hf : bijective f) : injective f := hf.1
protected lemma bijective.surjective {f : α → β} (hf : bijective f) : surjective f := hf.2

theorem injective.eq_iff (I : injective f) {a b : α} :
  f a = f b ↔ a = b :=
⟨@I _ _, congr_arg f⟩

theorem injective.eq_iff' (I : injective f) {a b : α} {c : β} (h : f b = c) :
  f a = c ↔ a = b :=
h ▸ I.eq_iff

lemma injective.ne (hf : injective f) {a₁ a₂ : α} : a₁ ≠ a₂ → f a₁ ≠ f a₂ :=
mt (λ h => hf h)

lemma injective.ne_iff (hf : injective f) {x y : α} : f x ≠ f y ↔ x ≠ y :=
⟨mt $ congr_arg f, hf.ne⟩

lemma injective.ne_iff' (hf : injective f) {x y : α} {z : β} (h : f y = z) :
  f x ≠ z ↔ x ≠ y :=
h ▸ hf.ne_iff

/-- If the co-domain `β` of an injective function `f : α → β` has decidable equality, then
the domain `α` also has decidable equality. -/
def injective.decidable_eq [DecidableEq β] (I : injective f) : DecidableEq α :=
λ a b => decidable_of_iff _ I.eq_iff

lemma injective.of_comp {g : γ → α} (I : injective (f ∘ g)) : injective g :=
λ {x y} h => I $ show f (g x) = f (g y) from congr_arg f h

lemma injective.of_comp_iff {f : α → β} (hf : injective f) (g : γ → α) :
  injective (f ∘ g) ↔ injective g :=
⟨injective.of_comp, hf.comp⟩

lemma injective.of_comp_iff' (f : α → β) {g : γ → α} (hg : bijective g) :
  injective (f ∘ g) ↔ injective f :=
⟨ λ h x y => let ⟨x', hx⟩ := hg.surjective x
             let ⟨y', hy⟩ := hg.surjective y
             hx ▸ hy ▸ λ hf => h hf ▸ rfl,
  λ h => h.comp hg.injective⟩

lemma injective_of_subsingleton [Subsingleton α] (f : α → β) :
  injective f :=
λ {a b} ab => Subsingleton.elim _ _

lemma injective.dite (p : α → Prop) [DecidablePred p]
  {f : {a : α // p a} → β} {f' : {a : α // ¬ p a} → β}
  (hf : injective f) (hf' : injective f')
  (im_disj : ∀ {x x' : α} {hx : p x} {hx' : ¬ p x'}, f ⟨x, hx⟩ ≠ f' ⟨x', hx'⟩) :
  Function.injective (λ x => if h : p x then f ⟨x, h⟩ else f' ⟨x, h⟩) :=
by intros x₁ x₂ h
   --TODO mathlib3 uses dsimp here
   have hrw1 : (fun (x : α) => if h : p x then f ⟨x, h⟩ else f' ⟨x, h⟩) x₁ =
                if h : p x₁ then f ⟨x₁, h⟩ else f' ⟨x₁, h⟩ := rfl
   have hrw2 : (fun (x : α) => if h : p x then f ⟨x, h⟩ else f' ⟨x, h⟩) x₂ =
               if h : p x₂ then f ⟨x₂, h⟩ else f' ⟨x₂, h⟩ := rfl
   rw [hrw1, hrw2] at h
   exact Decidable.byCases
     (λ (h₁ : p x₁) =>
       Decidable.byCases
         (λ (h₂ : p x₂) => by rw [dif_pos h₁, dif_pos h₂] at h
                              injection (hf h)
                              assumption)
         (λ (h₂ : ¬ p x₂) => by rw [dif_pos h₁, dif_neg h₂] at h
                                exact (im_disj h).elim))
     (λ (h₁ : ¬ p x₁) =>
       Decidable.byCases
         (λ (h₂ : p x₂) => by rw [dif_neg h₁, dif_pos h₂] at h
                              exact (im_disj h.symm).elim)
         (λ (h₂ : ¬ p x₂) => by rw [dif_neg h₁, dif_neg h₂] at h
                                injection (hf' h)
                                assumption))

lemma surjective.of_comp {g : γ → α} (S : surjective (f ∘ g)) : surjective f :=
λ y => let ⟨x, h⟩ := S y
       ⟨g x, h⟩

lemma surjective.of_comp_iff (f : α → β) {g : γ → α} (hg : surjective g) :
  surjective (f ∘ g) ↔ surjective f :=
⟨surjective.of_comp, λ h => h.comp hg⟩

lemma surjective.of_comp_iff' {f : α → β} (hf : bijective f) (g : γ → α) :
  surjective (f ∘ g) ↔ surjective g :=
⟨λ h x => let ⟨x', hx'⟩ := h (f x)
          ⟨x', hf.injective hx'⟩, hf.surjective.comp⟩

instance decidable_eq_pfun (p : Prop) [Decidable p] (α : p → Type _)
  [∀ hp, DecidableEq (α hp)] : DecidableEq (∀hp, α hp)
| f, g => decidable_of_iff (∀ hp, f hp = g hp) funext_iff.symm

theorem surjective.forall {f : α → β} (hf : surjective f) {p : β → Prop} :
  (∀ y, p y) ↔ ∀ x, p (f x) :=
⟨λ h x => h (f x),
 λ h y => let ⟨x, hx⟩ := hf y
          hx ▸ h x⟩

theorem surjective.forall₂ {f : α → β} (hf : surjective f) {p : β → β → Prop} :
  (∀ y₁ y₂, p y₁ y₂) ↔ ∀ x₁ x₂, p (f x₁) (f x₂) :=
hf.forall.trans $ forall_congr' $ λ x => hf.forall

theorem surjective.forall₃ {f : α → β} (hf : surjective f) {p : β → β → β → Prop} :
  (∀ y₁ y₂ y₃, p y₁ y₂ y₃) ↔ ∀ x₁ x₂ x₃, p (f x₁) (f x₂) (f x₃) :=
hf.forall.trans $ forall_congr' $ λ x => hf.forall₂

theorem surjective.exists {f : α → β} (hf : surjective f) {p : β → Prop} :
  (∃ y, p y) ↔ ∃ x, p (f x) :=
⟨λ ⟨y, hy⟩ => let ⟨x, hx⟩ := hf y
              ⟨x, hx.symm ▸ hy⟩,
 λ ⟨x, hx⟩ => ⟨f x, hx⟩⟩

theorem surjective.exists₂ {f : α → β} (hf : surjective f) {p : β → β → Prop} :
  (∃ y₁ y₂, p y₁ y₂) ↔ ∃ x₁ x₂, p (f x₁) (f x₂) :=
hf.exists.trans $ exists_congr $ λ x => hf.exists

theorem surjective.exists₃ {f : α → β} (hf : surjective f) {p : β → β → β → Prop} :
  (∃ y₁ y₂ y₃, p y₁ y₂ y₃) ↔ ∃ x₁ x₂ x₃, p (f x₁) (f x₂) (f x₃) :=
hf.exists.trans $ exists_congr $ λ x => hf.exists₂

lemma bijective_iff_exists_unique (f : α → β) : bijective f ↔
  ∀ b : β, ∃! (a : α), f a = b :=
⟨ λ hf b => let ⟨a, ha⟩ := hf.surjective b
            ⟨a, ha, λ a' ha' => hf.injective (ha'.trans ha.symm)⟩,
  λ he => ⟨
    λ {a a'} h => unique_of_exists_unique (he (f a')) h rfl,
    λ b => ExistsUnique.exists (he b) ⟩⟩

/-- Shorthand for using projection notation with `function.bijective_iff_exists_unique`. -/
lemma bijective.exists_unique {f : α → β} (hf : bijective f) (b : β) : ∃! (a : α), f a = b :=
(bijective_iff_exists_unique f).mp hf b

lemma bijective.of_comp_iff (f : α → β) {g : γ → α} (hg : bijective g) :
  bijective (f ∘ g) ↔ bijective f :=
and_congr (injective.of_comp_iff' _ hg) (surjective.of_comp_iff _ hg.surjective)

lemma bijective.of_comp_iff' {f : α → β} (hf : bijective f) (g : γ → α) :
  Function.bijective (f ∘ g) ↔ Function.bijective g :=
and_congr (injective.of_comp_iff hf.injective _) (surjective.of_comp_iff' hf _)

/-- Cantor's diagonal argument implies that there are no surjective functions from `α`
to `Set α`. -/
theorem cantor_surjective {α} (f : α → Set α) : ¬ Function.surjective f
| h => let ⟨D, e⟩ := h (λ a => ¬ f a a)
       by have x := @iff_not_self (f D D)
          exact (@iff_not_self (f D D)) $ iff_of_eq (congr_fun e D)

/-- Cantor's diagonal argument implies that there are no injective functions from `Set α` to `α`. -/
theorem cantor_injective {α : Type _} (f : (Set α) → α) :
  ¬ Function.injective f
| i => cantor_surjective (λ a b => ∀ U, a = f U → U b) $
       RightInverse.surjective
         (λ U => funext $ λ a => propext ⟨λ h => h U rfl, λ h' U' e => i e ▸ h'⟩)

/-- `g` is a partial inverse to `f` (an injective but not necessarily
  surjective function) if `g y = some x` implies `f x = y`, and `g y = none`
  implies that `y` is not in the range of `f`. -/
def is_partial_inv {α β} (f : α → β) (g : β → Option α) : Prop :=
∀ x y, g y = some x ↔ f x = y

theorem is_partial_inv_left {α β} {f : α → β} {g} (H : is_partial_inv f g) (x) : g (f x) = some x :=
(H _ _).2 rfl

theorem injective_of_partial_inv {α β} {f : α → β} {g} (H : is_partial_inv f g) : injective f :=
λ {a b} h => Option.some.inj $ ((H _ _).2 h).symm.trans ((H _ _).2 rfl)

-- TODO mathlib3 uses Mem here
theorem injective_of_partial_inv_right {α β} {f : α → β} {g} (H : is_partial_inv f g)
 (x y b) (h₁ : g x = some b) (h₂ : g y = some b) : x = y :=
((H _ _).1 h₁).symm.trans ((H _ _).1 h₂)

theorem LeftInverse.comp_eq_id {f : α → β} {g : β → α} (h : LeftInverse f g) : f ∘ g = id :=
funext h

theorem LeftInverse_iff_comp {f : α → β} {g : β → α} : LeftInverse f g ↔ f ∘ g = id :=
⟨LeftInverse.comp_eq_id, congr_fun⟩

theorem RightInverse.comp_eq_id {f : α → β} {g : β → α} (h : RightInverse f g) : g ∘ f = id :=
funext h

theorem RightInverse_iff_comp {f : α → β} {g : β → α} : RightInverse f g ↔ g ∘ f = id :=
⟨RightInverse.comp_eq_id, congr_fun⟩

theorem LeftInverse.comp {f : α → β} {g : β → α} {h : β → γ} {i : γ → β}
  (hf : LeftInverse f g) (hh : LeftInverse h i) : LeftInverse (h ∘ f) (g ∘ i) :=
λ a => show h (f (g (i a))) = a by rw [hf (i a), hh a]

theorem RightInverse.comp {f : α → β} {g : β → α} {h : β → γ} {i : γ → β}
  (hf : RightInverse f g) (hh : RightInverse h i) : RightInverse (h ∘ f) (g ∘ i) :=
LeftInverse.comp hh hf

theorem LeftInverse.RightInverse {f : α → β} {g : β → α} (h : LeftInverse g f) :
  RightInverse f g := h

theorem RightInverse.LeftInverse {f : α → β} {g : β → α} (h : RightInverse g f) :
  LeftInverse f g := h

theorem LeftInverse.surjective {f : α → β} {g : β → α} (h : LeftInverse f g) :
  surjective f :=
h.RightInverse.surjective

theorem RightInverse.injective {f : α → β} {g : β → α} (h : RightInverse f g) :
  injective f :=
h.LeftInverse.injective

theorem LeftInverse.eq_RightInverse {f : α → β} {g₁ g₂ : β → α} (h₁ : LeftInverse g₁ f)
  (h₂ : Function.RightInverse g₂ f) :
  g₁ = g₂ := by
  have h₃ : g₁ = g₁ ∘ f ∘ g₂ := by rw [h₂.comp_eq_id, comp.right_id]
  have h₄ : g₁ ∘ f ∘ g₂ = g₂ := by rw [← comp.assoc, h₁.comp_eq_id, comp.left_id]
  rwa [←h₄]

attribute [local instance] Classical.propDecidable

/-- We can use choice to construct explicitly a partial inverse for
  a given injective function `f`. -/
noncomputable def partial_inv {α β} (f : α → β) (b : β) : Option α :=
if h : ∃ a, f a = b then some (Classical.choose h) else none

theorem partial_inv_of_injective {α β} {f : α → β} (I : injective f) :
  is_partial_inv f (partial_inv f)
| a, b =>
⟨λ h => have hpi: partial_inv f b = if h : ∃ a, f a = b then some (Classical.choose h) else none := rfl
        if h' : ∃ a, f a = b
        then by rw [hpi, dif_pos h'] at h
                injection h with h
                subst h
                apply Classical.choose_spec h'
        else by rw [hpi, dif_neg h'] at h; contradiction,
 λ e => e ▸ have h : ∃ a', f a' = f a := ⟨_, rfl⟩
            (dif_pos h).trans (congr_arg _ (I $ Classical.choose_spec h))⟩

theorem partial_inv_left {α β} {f : α → β} (I : injective f) : ∀ x, partial_inv f (f x) = some x :=
is_partial_inv_left (partial_inv_of_injective I)

end

section inv_fun
variable {α : Type u} [n : Nonempty α] {β : Sort v} {f : α → β} {s : Set α} {a : α} {b : β}
attribute [local instance] Classical.propDecidable

/-- Construct the inverse for a function `f` on domain `s`. This function is a right inverse of `f`
on `f '' s`. For a computable version, see `function.injective.inv_of_mem_range`. -/
noncomputable def inv_fun_on (f : α → β) (s : Set α) (b : β) : α :=
if h : ∃a, a ∈ s ∧ f a = b then Classical.choose h else Classical.choice n

theorem inv_fun_on_pos (h : ∃a∈s, f a = b) : inv_fun_on f s b ∈ s ∧ f (inv_fun_on f s b) = b :=
by have h1 : inv_fun_on f s b =
     if h : ∃a, a ∈ s ∧ f a = b then Classical.choose h else Classical.choice n := rfl
   rw [dif_pos h] at h1
   rw [h1]
   exact Classical.choose_spec h

theorem inv_fun_on_mem (h : ∃a∈s, f a = b) : inv_fun_on f s b ∈ s := (inv_fun_on_pos h).left

theorem inv_fun_on_eq (h : ∃a∈s, f a = b) : f (inv_fun_on f s b) = b := (inv_fun_on_pos h).right

theorem inv_fun_on_eq' (h : ∀ x ∈ s, ∀ y ∈ s, f x = f y → x = y) (ha : a ∈ s) :
  inv_fun_on f s (f a) = a :=
have : ∃a'∈s, f a' = f a := ⟨a, ha, rfl⟩
h _ (inv_fun_on_mem this) _ ha (inv_fun_on_eq this)

theorem inv_fun_on_neg (h : ¬ ∃a∈s, f a = b) : inv_fun_on f s b = Classical.choice n :=
by have h1 : inv_fun_on f s b =
     if h : ∃a, a ∈ s ∧ f a = b then Classical.choose h else Classical.choice n := rfl
   rwa [dif_neg h] at h1

/-- The inverse of a function (which is a left inverse if `f` is injective
  and a right inverse if `f` is surjective). -/
noncomputable def inv_fun (f : α → β) : β → α := inv_fun_on f Set.univ

theorem inv_fun_eq (h : ∃a, f a = b) : f (inv_fun f b) = b :=
inv_fun_on_eq $ let ⟨a, ha⟩ := h
                ⟨a, trivial, ha⟩

lemma inv_fun_neg (h : ¬ ∃ a, f a = b) : inv_fun f b = Classical.choice n :=
by refine inv_fun_on_neg (mt ?_ h); exact λ ⟨a, _, ha⟩ => ⟨a, ha⟩

theorem inv_fun_eq_of_injective_of_RightInverse {g : β → α}
  (hf : injective f) (hg : RightInverse g f) : inv_fun f = g :=
funext $ λ b => hf (by rw [hg b]
                       exact inv_fun_eq ⟨g b, hg b⟩)

lemma RightInverse_inv_fun (hf : surjective f) : RightInverse (inv_fun f) f :=
λ b => inv_fun_eq $ hf b

lemma LeftInverse_inv_fun (hf : injective f) : LeftInverse (inv_fun f) f :=
λ b => have : f (inv_fun f (f b)) = f b := inv_fun_eq ⟨b, rfl⟩
       hf this

lemma inv_fun_surjective (hf : injective f) : surjective (inv_fun f) :=
(LeftInverse_inv_fun hf).surjective

lemma inv_fun_comp (hf : injective f) : inv_fun f ∘ f = id := funext $ LeftInverse_inv_fun hf

end inv_fun

section inv_fun
variable {α : Type u} [i : Nonempty α] {β : Sort v} {f : α → β}

lemma injective.has_LeftInverse (hf : injective f) : has_LeftInverse f :=
⟨inv_fun f, LeftInverse_inv_fun hf⟩

lemma injective_iff_has_LeftInverse : injective f ↔ has_LeftInverse f :=
⟨injective.has_LeftInverse, has_LeftInverse.injective⟩

end inv_fun

section surj_inv
variable {α : Sort u} {β : Sort v} {f : α → β}

/-- The inverse of a surjective function. (Unlike `inv_fun`, this does not require
  `α` to be inhabited.) -/
noncomputable def surj_inv {f : α → β} (h : surjective f) (b : β) : α := Classical.choose (h b)

lemma surj_inv_eq (h : surjective f) (b) : f (surj_inv h b) = b := Classical.choose_spec (h b)

lemma RightInverse_surj_inv (hf : surjective f) : RightInverse (surj_inv hf) f :=
surj_inv_eq hf

lemma LeftInverse_surj_inv (hf : bijective f) : LeftInverse (surj_inv hf.2) f :=
RightInverse_of_injective_of_LeftInverse hf.1 (RightInverse_surj_inv hf.2)

lemma surjective.has_RightInverse (hf : surjective f) : has_RightInverse f :=
⟨_, RightInverse_surj_inv hf⟩

lemma surjective_iff_has_RightInverse : surjective f ↔ has_RightInverse f :=
⟨surjective.has_RightInverse, has_RightInverse.surjective⟩

lemma bijective_iff_has_inverse : bijective f ↔ ∃ g, LeftInverse g f ∧ RightInverse g f :=
⟨λ hf =>  ⟨_, LeftInverse_surj_inv hf, RightInverse_surj_inv hf.2⟩,
 λ ⟨g, gl, gr⟩ => ⟨gl.injective,  gr.surjective⟩⟩

lemma injective_surj_inv (h : surjective f) : injective (surj_inv h) :=
(RightInverse_surj_inv h).injective

lemma surjective_to_subsingleton [na : Nonempty α] [Subsingleton β] (f : α → β) :
  surjective f :=
λ y => let ⟨a⟩ := na; ⟨a, Subsingleton.elim _ _⟩

end surj_inv

section update
variable {α : Sort u} {β : α → Sort v} {α' : Sort w} [DecidableEq α] [DecidableEq α']

/-- Replacing the value of a function at a given point by a given value. -/
def update (f : ∀a, β a) (a' : α) (v : β a') (a : α) : β a :=
if h : a = a' then Eq.rec (motive := λ a _ => β a) v h.symm else f a

/-- On non-dependent functions, `function.update` can be expressed as an `ite` -/
lemma update_apply {β : Sort _} (f : α → β) (a' : α) (b : β) (a : α) :
  update f a' b a = if a = a' then b else f a :=
by have h2 : (h : a = a') → Eq.rec (motive := λ a b => β) b h.symm = b :=
     by intro h
        rw [eq_rec_constant]
   have h3 : (λ h : a = a' => Eq.rec (motive := λ a b => β) b h.symm) =
             (λ _ : a = a' =>  b) := funext h2
   let f := λ x => dite (a = a') x (λ (_: ¬ a = a') => (f a))
   exact congrArg f h3

@[simp] lemma update_same (a : α) (v : β a) (f : ∀a, β a) : update f a v a = v :=
dif_pos rfl

lemma update_injective (f : ∀a, β a) (a' : α) : injective (update f a') :=
by intros v v' h
   have h' := congrFun h a'
   rwa [update_same, update_same] at h'

@[simp] lemma update_noteq {a a' : α} (h : a ≠ a') (v : β a') (f : ∀a, β a) :
  update f a' v a = f a :=
dif_neg h

lemma forall_update_iff (f : ∀a, β a) {a : α} {b : β a} (p : ∀a, β a → Prop) :
  (∀ x, p x (update f a b x)) ↔ p a b ∧ ∀ x, x ≠ a → p x (f x) :=
Iff.intro
  (by intro h
      have h1 := h a
      have h2 : update f a b a = b := update_same _ _ _
      rw [h2] at h1
      refine ⟨h1, ?_⟩
      intro x hx
      have h3 := update_noteq hx b f
      rw [←h3]
      exact h x)
  (by intro ⟨hp,h⟩ x
      have h1 : x = a ∨ x ≠ a := Decidable.em _
      match h1 with
      | Or.inl he => rw [he, update_same]
                     exact hp
      | Or.inr hne => have h4 := update_noteq hne b f
                      rw [h4]
                      exact h x hne)

lemma update_eq_iff {a : α} {b : β a} {f g : ∀ a, β a} :
  update f a b = g ↔ b = g a ∧ ∀ x, x ≠ a -> f x = g x :=
funext_iff.trans $ forall_update_iff _ (λ x y => y = g x)

lemma eq_update_iff {a : α} {b : β a} {f g : ∀ a, β a} :
  g = update f a b ↔ g a = b ∧ ∀ x, x ≠ a -> g x = f x :=
funext_iff.trans $ forall_update_iff _ (λ x y => g x = y)

@[simp] lemma update_eq_self (a : α) (f : ∀a, β a) : update f a (f a) = f :=
update_eq_iff.2 ⟨rfl, λ _ _ => rfl⟩

lemma update_comp_eq_of_forall_ne' {α'} (g : ∀ a, β a) {f : α' → α} {i : α} (a : β i)
  (h : ∀ x, f x ≠ i) :
  (λ j => (update g i a) (f j)) = (λ j => g (f j)) :=
funext $ λ x => update_noteq (h _) _ _

/-- Non-dependent version of `function.update_comp_eq_of_forall_ne'` -/
lemma update_comp_eq_of_forall_ne {α β : Sort _} (g : α' → β) {f : α → α'} {i : α'} (a : β)
  (h : ∀ x, f x ≠ i) :
  (update g i a) ∘ f = g ∘ f :=
update_comp_eq_of_forall_ne' g a h

lemma update_comp_eq_of_injective' (g : ∀a, β a) {f : α' → α} (hf : Function.injective f)
  (i : α') (a : β (f i)) :
  (λ j => update g (f i) a (f j)) = update (λ i => g (f i)) i a :=
eq_update_iff.2 ⟨update_same _ _ _, λ j hj => update_noteq (hf.ne hj) _ _⟩

/-- Non-dependent version of `function.update_comp_eq_of_injective'` -/
lemma update_comp_eq_of_injective {β : Sort _} (g : α' → β) {f : α → α'}
  (hf : Function.injective f) (i : α) (a : β) :
  (Function.update g (f i) a) ∘ f = Function.update (g ∘ f) i a :=
update_comp_eq_of_injective' g hf i a

lemma apply_update {ι : Sort _} [DecidableEq ι] {α β : ι → Sort _}
  (f : ∀i, α i → β i) (g : ∀i, α i) (i : ι) (v : α i) (j : ι) :
  f j (update g i v j) = update (λ k => f k (g k)) i (f i v) j :=
by by_cases h : j = i
   subst j; simp
   simp[h]

lemma comp_update {α' : Sort _} {β : Sort _} (f : α' → β) (g : α → α') (i : α) (v : α') :
  f ∘ (update g i v) = update (f ∘ g) i (f v) :=
funext $ apply_update _ _ _ _

theorem update_comm {α} [DecidableEq α] {β : α → Sort _}
  {a b : α} (h : a ≠ b) (v : β a) (w : β b) (f : ∀a, β a) :
  update (update f a v) b w = update (update f b w) a v :=
by funext c
   simp only [update]
   by_cases h₁ : c = b <;> by_cases h₂ : c = a
   · rw [dif_pos h₁, dif_pos h₂]
     cases h (h₂.symm.trans h₁)
   · rw [dif_pos h₁, dif_pos h₁, dif_neg h₂]
   · rw [dif_neg h₁, dif_neg h₁, dif_pos h₂]
   · rw [dif_neg h₁, dif_neg h₁, dif_neg h₂]

@[simp] theorem update_idem {α} [DecidableEq α] {β : α → Sort _}
  {a : α} (v w : β a) (f : ∀a, β a) : update (update f a v) a w = update f a w :=
by funext b
   by_cases b = a <;> simp [update, h]

end update

section extend

attribute [local instance] Classical.propDecidable

variable {α β γ : Type _} {f : α → β}

/-- `extend f g e'` extends a function `g : α → γ`
along a function `f : α → β` to a function `β → γ`,
by using the values of `g` on the range of `f`
and the values of an auxiliary function `e' : β → γ` elsewhere.

Mostly useful when `f` is injective. -/
noncomputable def extend (f : α → β) (g : α → γ) (e' : β → γ) : β → γ :=
λ b => if h : ∃ a, f a = b then g (Classical.choose h) else e' b

lemma extend_def (f : α → β) (g : α → γ) (e' : β → γ) (b : β) [hd : Decidable (∃ a, f a = b)] :
  extend f g e' b = if h : ∃ a, f a = b then g (Classical.choose h) else e' b :=
  by rw [Subsingleton.elim hd] -- align the Decidable instances implicitly used by `dite`
     exact rfl

@[simp] lemma extend_apply (hf : injective f) (g : α → γ) (e' : β → γ) (a : α) :
  extend f g e' (f a) = g a :=
by simp only [extend_def, dif_pos, exists_apply_eq_apply]
   exact congr_arg g (hf $ Classical.choose_spec (exists_apply_eq_apply f a))

@[simp] lemma extend_comp (hf : injective f) (g : α → γ) (e' : β → γ) :
  extend f g e' ∘ f = g :=
funext $ λ a => extend_apply hf g e' a

end extend

lemma uncurry_def {α β γ} (f : α → β → γ) : uncurry f = (λp => f p.1 p.2) :=
rfl

@[simp] lemma uncurry_apply_pair {α β γ} (f : α → β → γ) (x : α) (y : β) :
  uncurry f (x, y) = f x y :=
rfl

@[simp] lemma curry_apply {α β γ} (f : α × β → γ) (x : α) (y : β) :
  curry f x y = f (x, y) :=
rfl

section bicomp
variable {α β γ δ ε : Type _}

/-- Compose a binary function `f` with a pair of unary functions `g` and `h`.
If both arguments of `f` have the same type and `g = h`, then `bicompl f g g = f on g`. -/
def bicompl (f : γ → δ → ε) (g : α → γ) (h : β → δ) (a b) :=
f (g a) (h b)

/-- Compose an unary function `f` with a binary function `g`. -/
def bicompr (f : γ → δ) (g : α → β → γ) (a b) :=
f (g a b)

-- Suggested local notation:
local notation f  " ∘₂ " g => bicompr f g

lemma uncurry_bicompr (f : α → β → γ) (g : γ → δ) :
  uncurry (g ∘₂ f) = (g ∘ uncurry f) := rfl

lemma uncurry_bicompl (f : γ → δ → ε) (g : α → γ) (h : β → δ) :
  uncurry (bicompl f g h) = (uncurry f) ∘ (Prod.map g h) :=
by ext ⟨x, y⟩; exact rfl

end bicomp

section uncurry

/-- Records a way to turn an element of `α` into a function from `β` to `γ`. The most generic use
is to recursively uncurry. For instance `f : α → β → γ → δ` will be turned into
`↿f : α × β × γ → δ`. One can also add instances for bundled maps. -/
class HasUncurry (α : Type u) (β : outParam (Type v)) (γ : outParam (Type w)) where
  uncurry : α → (β → γ)

/- Uncurrying operator. The most generic use is to recursively uncurry. For instance
`f : α → β → γ → δ` will be turned into `↿f : α × β × γ → δ`. One can also add instances
for bundled maps. -/
notation:max "↿" x:max => HasUncurry.uncurry x

instance HasUncurry_base : HasUncurry (α → β) α β := ⟨id⟩

instance HasUncurry_induction [HasUncurry β γ δ] : HasUncurry (α → β) (α × γ) δ :=
⟨λ f p => ↿(f p.1) p.2⟩

end uncurry

/-- A function is involutive, if `f ∘ f = id`. -/
def involutive {α} (f : α → α) : Prop := ∀ x, f (f x) = x

lemma involutive_iff_iter_2_eq_id {α} {f : α → α} : involutive f ↔ (f^[2] = id) :=
funext_iff.symm

namespace involutive
variable {α : Sort u} {f : α → α} (h : involutive f)

@[simp]
lemma comp_self : f ∘ f = id := funext h

protected lemma LeftInverse : LeftInverse f f := h
protected lemma RightInverse : RightInverse f f := h

protected lemma injective : injective f := h.LeftInverse.injective
protected lemma surjective : surjective f := λ x => ⟨f x, h x⟩
protected lemma bijective : bijective f := ⟨h.injective, h.surjective⟩

/-- Involuting an `ite` of an involuted value `x : α` negates the `Prop` condition in the `ite`. -/
protected lemma ite_not (P : Prop) [Decidable P] (x : α) :
  f (ite P x (f x)) = ite (¬ P) x (f x) :=
by rw [apply_ite f, h, ite_not]

/-- An involution commutes across an equality. Compare to `function.injective.eq_iff`. -/
protected lemma eq_iff {x y : α} : f x = y ↔ x = f y :=
Function.injective.eq_iff' (involutive.injective h) (h y)

end involutive

/-- The property of a binary function `f : α → β → γ` being injective.
Mathematically this should be thought of as the corresponding function `α × β → γ` being injective.
-/
@[reducible] def injective2 {α β γ} (f : α → β → γ) : Prop :=
∀ {a₁ a₂ b₁ b₂}, f a₁ b₁ = f a₂ b₂ → a₁ = a₂ ∧ b₁ = b₂

namespace injective2
variable {α β γ : Type _} (f : α → β → γ)

protected lemma left (hf : injective2 f) {a₁ a₂ b₁ b₂} (h : f a₁ b₁ = f a₂ b₂) : a₁ = a₂ :=
(hf h).1

protected lemma right (hf : injective2 f) {a₁ a₂ b₁ b₂} (h : f a₁ b₁ = f a₂ b₂) : b₁ = b₂ :=
(hf h).2

lemma eq_iff (hf : injective2 f) {a₁ a₂ b₁ b₂} : f a₁ b₁ = f a₂ b₂ ↔ a₁ = a₂ ∧ b₁ = b₂ :=
⟨λ h => hf h, λ⟨h1, h2⟩ => congr_arg2 f h1 h2⟩

end injective2

section sometimes
attribute [local instance] Classical.propDecidable

/-- `sometimes f` evaluates to some value of `f`, if it exists. This function is especially
interesting in the case where `α` is a proposition, in which case `f` is necessarily a
constant function, so that `sometimes f = f a` for all `a`. -/
noncomputable def sometimes {α β} [Nonempty β] (f : α → β) : β :=
if h : Nonempty α then f (Classical.choice h) else Classical.choice ‹_›

theorem sometimes_eq {p : Prop} {α} [Nonempty α] (f : p → α) (a : p) : sometimes f = f a :=
dif_pos ⟨a⟩

theorem sometimes_spec {p : Prop} {α} [Nonempty α]
  (P : α → Prop) (f : p → α) (a : p) (h : P (f a)) : P (sometimes f) :=
by rwa [sometimes_eq]

end sometimes

end Function

/-- `s.piecewise f g` is the function equal to `f` on the set `s`, and to `g` on its complement. -/
def set.piecewise {α : Type u} {β : α → Sort v} (s : Set α) (f g : ∀i, β i)
  [∀j, Decidable (j ∈ s)] :
  ∀i, β i :=
λi => if i ∈ s then f i else g i

-- TODO: eq_rec_on_bijective, eq_mp_bijective, eq_mpr_bijective, cast_biject, eq_rec_inj, cast_inj

/-- A set of functions "separates points"
if for each pair of distinct points there is a function taking different values on them. -/
def set.separates_points {α β : Type _} (A : Set (α → β)) : Prop :=
∀ {x y : α}, x ≠ y → ∃ f ∈ A, (f x : β) ≠ f y

-- TODO: is_symm_op.flip_eq


/-
Copyright (c) 2021 Adam Topaz. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Calle Sönne, Adam Topaz

! This file was ported from Lean 3 source module topology.discrete_quotient
! leanprover-community/mathlib commit d101e93197bb5f6ea89bd7ba386b7f7dff1f3903
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Topology.Separation
import Mathlib.Topology.SubsetProperties
import Mathlib.Topology.LocallyConstant.Basic

/-!

# Discrete quotients of a topological space.

This file defines the type of discrete quotients of a topological space,
denoted `DiscreteQuotient X`. To avoid quantifying over types, we model such
quotients as setoids whose equivalence classes are clopen.

## Definitions
1. `DiscreteQuotient X` is the type of discrete quotients of `X`.
  It is endowed with a coercion to `Type`, which is defined as the
  quotient associated to the setoid in question, and each such quotient
  is endowed with the discrete topology.
2. Given `S : DiscreteQuotient X`, the projection `X → S` is denoted
  `S.proj`.
3. When `X` is compact and `S : DiscreteQuotient X`, the space `S` is
  endowed with a `Fintype` instance.

## Order structure

The type `DiscreteQuotient X` is endowed with an instance of a `SemilatticeInf` with `OrderTop`.
The partial ordering `A ≤ B` mathematically means that `B.proj` factors through `A.proj`.
The top element `⊤` is the trivial quotient, meaning that every element of `X` is collapsed
to a point. Given `h : A ≤ B`, the map `A → B` is `DiscreteQuotient.ofLe h`.

Whenever `X` is a locally connected space, the type `DiscreteQuotient X` is also endowed with an
instance of a `OrderBot`, where the bot element `⊥` is given by the `connectedComponentSetoid`,
i.e., `x ~ y` means that `x` and `y` belong to the same connected component. In particular, if `X`
is a discrete topological space, then `x ~ y` is equivalent (propositionally, not definitionally) to
`x = y`.

Given `f : C(X, Y)`, we define a predicate `DiscreteQuotient.LeComap f A B` for `A :
DiscreteQuotient X` and `B : DiscreteQuotient Y`, asserting that `f` descends to `A → B`.  If
`cond : DiscreteQuotient.LeComap h A B`, the function `A → B` is obtained by
`DiscreteQuotient.map f cond`.

## Theorems

The two main results proved in this file are:

1. `DiscreteQuotient.eq_of_forall_proj_eq` which states that when `X` is compact, T₂, and totally
  disconnected, any two elements of `X` are equal if their projections in `Q` agree for all
  `Q : DiscreteQuotient X`.

2. `DiscreteQuotient.exists_of_compat` which states that when `X` is compact, then any
  system of elements of `Q` as `Q : DiscreteQuotient X` varies, which is compatible with
  respect to `DiscreteQuotient.ofLe`, must arise from some element of `X`.

## Remarks
The constructions in this file will be used to show that any profinite space is a limit
of finite discrete spaces.
-/

open Set Function

variable {α X Y Z : Type _} [TopologicalSpace X] [TopologicalSpace Y] [TopologicalSpace Z]

/-- The type of discrete quotients of a topological space. -/
@[ext] -- porting note: in Lean 4, uses projection to `r` instead of `Setoid`.
structure DiscreteQuotient (X : Type _) [TopologicalSpace X] extends Setoid X where
  /-- For every point `x`, the set `{ y | Rel x y }` is a clopen set. -/
  protected isOpen_setOf_rel : ∀ x, IsOpen (setOf (toSetoid.Rel x))
#align discrete_quotient DiscreteQuotient

namespace DiscreteQuotient

variable (S : DiscreteQuotient X)

-- porting note: new lemma
lemma toSetoid_injective : Function.Injective (@toSetoid X _)
  | ⟨_, _⟩, ⟨_, _⟩, _ => by congr

/-- Construct a discrete quotient from a clopen set. -/
def ofClopen {A : Set X} (h : IsClopen A) : DiscreteQuotient X where
  toSetoid := ⟨fun x y => x ∈ A ↔ y ∈ A, fun _ => Iff.rfl,  Iff.symm,  Iff.trans⟩
  isOpen_setOf_rel x := by by_cases hx : x ∈ A <;> simp [Setoid.Rel, hx, h.1, h.2, ← compl_setOf]
#align discrete_quotient.of_clopen DiscreteQuotient.ofClopen

theorem refl : ∀ x, S.Rel x x := S.refl'
#align discrete_quotient.refl DiscreteQuotient.refl

theorem symm (x y : X) : S.Rel x y → S.Rel y x := S.symm'
#align discrete_quotient.symm DiscreteQuotient.symm

theorem trans (x y z : X) : S.Rel x y → S.Rel y z → S.Rel x z := S.trans'
#align discrete_quotient.trans DiscreteQuotient.trans

/-- The setoid whose quotient yields the discrete quotient. -/
add_decl_doc toSetoid

instance : CoeSort (DiscreteQuotient X) (Type _) :=
  ⟨fun S => Quotient S.toSetoid⟩

instance : TopologicalSpace S :=
  inferInstanceAs (TopologicalSpace (Quotient S.toSetoid))

/-- The projection from `X` to the given discrete quotient. -/
def proj : X → S := Quotient.mk''
#align discrete_quotient.proj DiscreteQuotient.proj

theorem fiber_eq (x : X) : S.proj ⁻¹' {S.proj x} = setOf (S.Rel x) :=
  Set.ext fun _ => eq_comm.trans Quotient.eq''
#align discrete_quotient.fiber_eq DiscreteQuotient.fiber_eq

theorem proj_surjective : Function.Surjective S.proj :=
  Quotient.surjective_Quotient_mk''
#align discrete_quotient.proj_surjective DiscreteQuotient.proj_surjective

theorem proj_quotientMap : QuotientMap S.proj :=
  quotientMap_quot_mk
#align discrete_quotient.proj_quotient_map DiscreteQuotient.proj_quotientMap

theorem proj_continuous : Continuous S.proj :=
  S.proj_quotientMap.continuous
#align discrete_quotient.proj_continuous DiscreteQuotient.proj_continuous

instance : DiscreteTopology S :=
  singletons_open_iff_discrete.1 <| S.proj_surjective.forall.2 fun x => by
    rw [← S.proj_quotientMap.isOpen_preimage, fiber_eq]
    exact S.isOpen_setOf_rel _

theorem proj_isLocallyConstant : IsLocallyConstant S.proj :=
  (IsLocallyConstant.iff_continuous S.proj).2 S.proj_continuous
#align discrete_quotient.proj_is_locally_constant DiscreteQuotient.proj_isLocallyConstant

theorem isClopen_preimage (A : Set S) : IsClopen (S.proj ⁻¹' A) :=
  (isClopen_discrete A).preimage S.proj_continuous
#align discrete_quotient.is_clopen_preimage DiscreteQuotient.isClopen_preimage

theorem isOpen_preimage (A : Set S) : IsOpen (S.proj ⁻¹' A) :=
  (S.isClopen_preimage A).1
#align discrete_quotient.is_open_preimage DiscreteQuotient.isOpen_preimage

theorem isClosed_preimage (A : Set S) : IsClosed (S.proj ⁻¹' A) :=
  (S.isClopen_preimage A).2
#align discrete_quotient.is_closed_preimage DiscreteQuotient.isClosed_preimage

theorem isClopen_setOf_rel (x : X) : IsClopen (setOf (S.Rel x)) := by
  rw [← fiber_eq]
  apply isClopen_preimage
#align discrete_quotient.is_clopen_set_of_rel DiscreteQuotient.isClopen_setOf_rel

instance : Inf (DiscreteQuotient X) :=
  ⟨fun S₁ S₂ => ⟨S₁.1 ⊓ S₂.1, fun x => (S₁.2 x).inter (S₂.2 x)⟩⟩

instance : SemilatticeInf (DiscreteQuotient X) :=
  Injective.semilatticeInf toSetoid toSetoid_injective fun _ _ => rfl

instance : OrderTop (DiscreteQuotient X) where
  top := ⟨⊤, fun _ => isOpen_univ⟩
  le_top a := by tauto

instance : Inhabited (DiscreteQuotient X) := ⟨⊤⟩

instance inhabitedQuotient [Inhabited X] : Inhabited S := ⟨S.proj default⟩
#align discrete_quotient.inhabited_quotient DiscreteQuotient.inhabitedQuotient

-- porting note: TODO: add instances about `Nonempty (Quot _)`/`Nonempty (Quotient _)`
instance [Nonempty X] : Nonempty S := Nonempty.map S.proj ‹_›

-- porting note: new lemma
/-- The quotient by `⊤ : DiscreteQuotient X` is a `Subsingleton`. -/
instance : Subsingleton (⊤ : DiscreteQuotient X) where
  allEq := by rintro ⟨_⟩ ⟨_⟩; exact Quotient.sound trivial

section Comap

variable (g : C(Y, Z)) (f : C(X, Y))

/-- Comap a discrete quotient along a continuous map. -/
def comap (S : DiscreteQuotient Y) : DiscreteQuotient X where
  toSetoid := Setoid.comap f S.1
  isOpen_setOf_rel _ := (S.2 _).preimage f.continuous
#align discrete_quotient.comap DiscreteQuotient.comap

@[simp]
theorem comap_id : S.comap (ContinuousMap.id X) = S := rfl
#align discrete_quotient.comap_id DiscreteQuotient.comap_id

@[simp]
theorem comap_comp (S : DiscreteQuotient Z) : S.comap (g.comp f) = (S.comap g).comap f :=
  rfl
#align discrete_quotient.comap_comp DiscreteQuotient.comap_comp

@[mono]
theorem comap_mono {A B : DiscreteQuotient Y} (h : A ≤ B) : A.comap f ≤ B.comap f := by tauto
#align discrete_quotient.comap_mono DiscreteQuotient.comap_mono

end Comap

section OfLe

variable {A B C : DiscreteQuotient X}

/-- The map induced by a refinement of a discrete quotient. -/
def ofLe (h : A ≤ B) : A → B :=
  Quotient.map' (fun x => x) h
#align discrete_quotient.of_le DiscreteQuotient.ofLe

@[simp]
theorem ofLe_refl : ofLe (le_refl A) = id := by
  ext ⟨⟩
  rfl
#align discrete_quotient.of_le_refl DiscreteQuotient.ofLe_refl

theorem ofLe_refl_apply (a : A) : ofLe (le_refl A) a = a := by simp
#align discrete_quotient.of_le_refl_apply DiscreteQuotient.ofLe_refl_apply

@[simp]
theorem ofLe_ofLe (h₁ : A ≤ B) (h₂ : B ≤ C) (x : A) : ofLe h₂ (ofLe h₁ x) = ofLe (h₁.trans h₂) x :=
  by
  rcases x with ⟨⟩
  rfl
#align discrete_quotient.of_le_of_le DiscreteQuotient.ofLe_ofLe

@[simp]
theorem ofLe_comp_ofLe (h₁ : A ≤ B) (h₂ : B ≤ C) : ofLe h₂ ∘ ofLe h₁ = ofLe (le_trans h₁ h₂) :=
  funext <| ofLe_ofLe _ _
#align discrete_quotient.of_le_comp_of_le DiscreteQuotient.ofLe_comp_ofLe

theorem ofLe_continuous (h : A ≤ B) : Continuous (ofLe h) :=
  continuous_of_discreteTopology
#align discrete_quotient.of_le_continuous DiscreteQuotient.ofLe_continuous

@[simp]
theorem ofLe_proj (h : A ≤ B) (x : X) : ofLe h (A.proj x) = B.proj x :=
  Quotient.sound' (B.refl _)
#align discrete_quotient.of_le_proj DiscreteQuotient.ofLe_proj

@[simp]
theorem ofLe_comp_proj (h : A ≤ B) : ofLe h ∘ A.proj = B.proj :=
  funext <| ofLe_proj _
#align discrete_quotient.of_le_comp_proj DiscreteQuotient.ofLe_comp_proj

end OfLe

/-- When `X` is a locally connected space, there is an `OrderBot` instance on
`DiscreteQuotient X`. The bottom element is given by `connectedComponentSetoid X`
-/
instance [LocallyConnectedSpace X] : OrderBot (DiscreteQuotient X) where
  bot :=
    { toSetoid := connectedComponentSetoid X
      isOpen_setOf_rel := fun x => by
        convert isOpen_connectedComponent (x := x)
        ext y
        simpa only [connectedComponentSetoid, ← connectedComponent_eq_iff_mem] using eq_comm }
  bot_le S := fun x y (h : connectedComponent x = connectedComponent y) =>
    (S.isClopen_setOf_rel x).connectedComponent_subset (S.refl _) <| h.symm ▸ mem_connectedComponent

@[simp]
theorem proj_bot_eq [LocallyConnectedSpace X] {x y : X} :
    proj ⊥ x = proj ⊥ y ↔ connectedComponent x = connectedComponent y :=
  Quotient.eq''
#align discrete_quotient.proj_bot_eq DiscreteQuotient.proj_bot_eq

theorem proj_bot_inj [DiscreteTopology X] {x y : X} : proj ⊥ x = proj ⊥ y ↔ x = y := by simp
#align discrete_quotient.proj_bot_inj DiscreteQuotient.proj_bot_inj

theorem proj_bot_injective [DiscreteTopology X] : Injective (⊥ : DiscreteQuotient X).proj :=
  fun _ _ => proj_bot_inj.1
#align discrete_quotient.proj_bot_injective DiscreteQuotient.proj_bot_injective

theorem proj_bot_bijective [DiscreteTopology X] : Bijective (⊥ : DiscreteQuotient X).proj :=
  ⟨proj_bot_injective, proj_surjective _⟩
#align discrete_quotient.proj_bot_bijective DiscreteQuotient.proj_bot_bijective

section Map

variable (f : C(X, Y)) (A A' : DiscreteQuotient X) (B B' : DiscreteQuotient Y)

/-- Given `f : C(X, Y)`, `DiscreteQuotient.LeComap f A B` is defined as
`A ≤ B.comap f`. Mathematically this means that `f` descends to a morphism `A → B`. -/
def LeComap : Prop :=
  A ≤ B.comap f
#align discrete_quotient.le_comap DiscreteQuotient.LeComap

theorem leComap_id : LeComap (.id X) A A := le_rfl
#align discrete_quotient.le_comap_id DiscreteQuotient.leComap_id

variable {A A' B B'} {f} {g : C(Y, Z)} {C : DiscreteQuotient Z}

@[simp]
theorem leComap_id_iff : LeComap (ContinuousMap.id X) A A' ↔ A ≤ A' :=
  Iff.rfl
#align discrete_quotient.le_comap_id_iff DiscreteQuotient.leComap_id_iff

theorem LeComap.comp : LeComap g B C → LeComap f A B → LeComap (g.comp f) A C := by tauto
#align discrete_quotient.le_comap.comp DiscreteQuotient.LeComap.comp

@[mono]
theorem LeComap.mono (h : LeComap f A B) (hA : A' ≤ A) (hB : B ≤ B') : LeComap f A' B' :=
  hA.trans <| h.trans <| comap_mono _ hB
#align discrete_quotient.le_comap.mono DiscreteQuotient.LeComap.mono

/-- Map a discrete quotient along a continuous map. -/
def map (f : C(X, Y)) (cond : LeComap f A B) : A → B := Quotient.map' f cond
#align discrete_quotient.map DiscreteQuotient.map

theorem map_continuous (cond : LeComap f A B) : Continuous (map f cond) :=
  continuous_of_discreteTopology
#align discrete_quotient.map_continuous DiscreteQuotient.map_continuous

@[simp]
theorem map_comp_proj (cond : LeComap f A B) : map f cond ∘ A.proj = B.proj ∘ f :=
  rfl
#align discrete_quotient.map_comp_proj DiscreteQuotient.map_comp_proj

@[simp]
theorem map_proj (cond : LeComap f A B) (x : X) : map f cond (A.proj x) = B.proj (f x) :=
  rfl
#align discrete_quotient.map_proj DiscreteQuotient.map_proj

@[simp]
theorem map_id : map _ (leComap_id A) = id := by ext ⟨⟩; rfl
#align discrete_quotient.map_id DiscreteQuotient.map_id

-- porting note: todo: figure out why `simpNF` says this is a bad `@[simp]` lemma
theorem map_comp (h1 : LeComap g B C) (h2 : LeComap f A B) :
    map (g.comp f) (h1.comp h2) = map g h1 ∘ map f h2 := by
  ext ⟨⟩
  rfl
#align discrete_quotient.map_comp DiscreteQuotient.map_comp

@[simp]
theorem ofLe_map (cond : LeComap f A B) (h : B ≤ B') (a : A) :
    ofLe h (map f cond a) = map f (cond.mono le_rfl h) a := by
  rcases a with ⟨⟩
  rfl
#align discrete_quotient.of_le_map DiscreteQuotient.ofLe_map

@[simp]
theorem ofLe_comp_map (cond : LeComap f A B) (h : B ≤ B') :
    ofLe h ∘ map f cond = map f (cond.mono le_rfl h) :=
  funext <| ofLe_map cond h
#align discrete_quotient.of_le_comp_map DiscreteQuotient.ofLe_comp_map

@[simp]
theorem map_ofLe (cond : LeComap f A B) (h : A' ≤ A) (c : A') :
    map f cond (ofLe h c) = map f (cond.mono h le_rfl) c := by
  rcases c with ⟨⟩
  rfl
#align discrete_quotient.map_of_le DiscreteQuotient.map_ofLe

@[simp]
theorem map_comp_ofLe (cond : LeComap f A B) (h : A' ≤ A) :
    map f cond ∘ ofLe h = map f (cond.mono h le_rfl) :=
  funext <| map_ofLe cond h
#align discrete_quotient.map_comp_of_le DiscreteQuotient.map_comp_ofLe

end Map

theorem fiber_subset_ofLe {A B : DiscreteQuotient X} (h : A ≤ B) (a : A) :
    A.proj ⁻¹' {a} ⊆ B.proj ⁻¹' {ofLe h a} := by
  rcases A.proj_surjective a with ⟨a, rfl⟩
  rw [fiber_eq, ofLe_proj, fiber_eq]
  exact fun _ h' => h h'
#align discrete_quotient.fiber_subset_of_le DiscreteQuotient.fiber_subset_ofLe

theorem exists_of_compat [CompactSpace X] (Qs : (Q : DiscreteQuotient X) → Q)
    (compat : ∀ (A B : DiscreteQuotient X) (h : A ≤ B), ofLe h (Qs _) = Qs _) :
    ∃ x : X, ∀ Q : DiscreteQuotient X, Q.proj x = Qs _ := by
  have H₁ : ∀ Q₁ Q₂, Q₁ ≤ Q₂ → proj Q₁ ⁻¹' {Qs Q₁} ⊆ proj Q₂ ⁻¹' {Qs Q₂} := fun _ _ h => by
    rw [← compat _ _ h]
    exact fiber_subset_ofLe _ _
  obtain ⟨x, hx⟩ : Set.Nonempty (⋂ Q, proj Q ⁻¹' {Qs Q}) :=
    IsCompact.nonempty_interᵢ_of_directed_nonempty_compact_closed
      (fun Q : DiscreteQuotient X => Q.proj ⁻¹' {Qs _}) (directed_of_inf H₁)
      (fun Q => (singleton_nonempty _).preimage Q.proj_surjective)
      (fun Q => (Q.isClosed_preimage {Qs _}).isCompact) fun Q => Q.isClosed_preimage _
  exact ⟨x, mem_interᵢ.1 hx⟩
#align discrete_quotient.exists_of_compat DiscreteQuotient.exists_of_compat

/-- If `X` is a compact space, then any discrete quotient of `X` is finite. -/
instance [CompactSpace X] : Finite S := by
  have : CompactSpace S := Quotient.compactSpace
  rwa [← isCompact_univ_iff, isCompact_iff_finite, finite_univ_iff] at this

end DiscreteQuotient

namespace LocallyConstant

variable (f : LocallyConstant X α)

/-- Any locally constant function induces a discrete quotient. -/
def discreteQuotient : DiscreteQuotient X where
  toSetoid := .comap f ⊥
  isOpen_setOf_rel _ := f.isLocallyConstant _
#align locally_constant.discrete_quotient LocallyConstant.discreteQuotient

/-- The (locally constant) function from the discrete quotient associated to a locally constant
function. -/
def lift : LocallyConstant f.discreteQuotient α :=
  ⟨fun a => Quotient.liftOn' a f fun _ _ => id, fun _ => isOpen_discrete _⟩
#align locally_constant.lift LocallyConstant.lift

@[simp]
theorem lift_comp_proj : f.lift ∘ f.discreteQuotient.proj = f := rfl
#align locally_constant.lift_comp_proj LocallyConstant.lift_comp_proj

end LocallyConstant


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import algebra.category.Group.abelian
import category_theory.limits.shapes.images
import category_theory.limits.types

/-!
# The category of commutative additive groups has images.

Note that we don't need to register any of the constructions here as instances, because we get them
from the fact that `AddCommGroup` is an abelian category.
-/

open category_theory
open category_theory.limits

universe u

namespace AddCommGroup

-- Note that because `injective_of_mono` is currently only proved in `Type 0`,
-- we restrict to the lowest universe here for now.
variables {G H : AddCommGroup.{0}} (f : G ⟶ H)

local attribute [ext] subtype.ext_val

section -- implementation details of `has_image` for AddCommGroup; use the API, not these
/-- the image of a morphism in AddCommGroup is just the bundling of `add_monoid_hom.range f` -/
def image : AddCommGroup := AddCommGroup.of (add_monoid_hom.range f)

/-- the inclusion of `image f` into the target -/
def image.ι : image f ⟶ H := f.range.subtype

instance : mono (image.ι f) := concrete_category.mono_of_injective (image.ι f) subtype.val_injective

/-- the corestriction map to the image -/
def factor_thru_image : G ⟶ image f := f.range_restrict

lemma image.fac : factor_thru_image f ≫ image.ι f = f :=
by { ext, refl, }

local attribute [simp] image.fac

variables {f}
/-- the universal property for the image factorisation -/
noncomputable def image.lift (F' : mono_factorisation f) : image f ⟶ F'.I :=
{ to_fun :=
  (λ x, F'.e (classical.indefinite_description _ x.2).1 : image f → F'.I),
  map_zero' :=
  begin
    haveI := F'.m_mono,
    apply injective_of_mono F'.m,
    change (F'.e ≫ F'.m) _ = _,
    rw [F'.fac, add_monoid_hom.map_zero],
    exact (classical.indefinite_description (λ y, f y = 0) _).2,
  end,
  map_add' :=
  begin
    intros x y,
    haveI := F'.m_mono,
    apply injective_of_mono F'.m,
    rw [add_monoid_hom.map_add],
    change (F'.e ≫ F'.m) _ = (F'.e ≫ F'.m) _ + (F'.e ≫ F'.m) _,
    rw [F'.fac],
    rw (classical.indefinite_description (λ z, f z = _) _).2,
    rw (classical.indefinite_description (λ z, f z = _) _).2,
    rw (classical.indefinite_description (λ z, f z = _) _).2,
    refl,
  end,
 }
lemma image.lift_fac (F' : mono_factorisation f) : image.lift F' ≫ F'.m = image.ι f :=
begin
  ext x,
  change (F'.e ≫ F'.m) _ = _,
  rw [F'.fac, (classical.indefinite_description _ x.2).2],
  refl,
end
end

/-- the factorisation of any morphism in AddCommGroup through a mono. -/
def mono_factorisation : mono_factorisation f :=
{ I := image f,
  m := image.ι f,
  e := factor_thru_image f }

/-- the factorisation of any morphism in AddCommGroup through a mono has the universal property of
the image. -/
noncomputable def is_image : is_image (mono_factorisation f) :=
{ lift := image.lift,
  lift_fac' := image.lift_fac }

/--
The categorical image of a morphism in `AddCommGroup`
agrees with the usual group-theoretical range.
-/
noncomputable def image_iso_range {G H : AddCommGroup.{0}} (f : G ⟶ H) :
  limits.image f ≅ AddCommGroup.of f.range :=
is_image.iso_ext (image.is_image f) (is_image f)

end AddCommGroup


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

! This file was ported from Lean 3 source module control.random
! leanprover-community/mathlib commit 70fd9563a21e7b963887c9360bd29b2393e6225a
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Control.Uliftable
import Mathbin.Data.Bitvec.Basic
import Mathbin.Data.Stream.Defs
import Mathbin.Tactic.NormNum

/-!
# Rand Monad and Random Class

This module provides tools for formulating computations guided by randomness and for
defining objects that can be created randomly.

## Main definitions
  * `rand` monad for computations guided by randomness;
  * `random` class for objects that can be generated randomly;
    * `random` to generate one object;
    * `random_r` to generate one object inside a range;
    * `random_series` to generate an infinite series of objects;
    * `random_series_r` to generate an infinite series of objects inside a range;
  * `io.mk_generator` to create a new random number generator;
  * `io.run_rand` to run a randomized computation inside the `io` monad;
  * `tactic.run_rand` to run a randomized computation inside the `tactic` monad

## Local notation

 * `i .. j` : `Icc i j`, the set of values between `i` and `j` inclusively;

## Tags

random monad io

## References

  * Similar library in Haskell: https://hackage.haskell.org/package/MonadRandom

-/

open List Io Applicative

universe u v w

#print RandG /-
/-- A monad to generate random objects using the generator type `g` -/
@[reducible]
def RandG (g : Type) (α : Type u) : Type u :=
  StateM (ULift.{u} g) α
#align rand_g RandG
-/

#print Rand /-
/-- A monad to generate random objects using the generator type `std_gen` -/
@[reducible]
def Rand :=
  RandG StdGen
#align rand Rand
-/

instance (g : Type) : Uliftable (RandG.{u} g) (RandG.{v} g) :=
  @StateT.uliftable' _ _ _ _ _ (Equiv.ulift.trans Equiv.ulift.symm)

open ULift hiding Inhabited

/-- Generate one more `ℕ` -/
def RandG.next {g : Type} [RandomGen g] : RandG g ℕ :=
  ⟨Prod.map id up ∘ RandomGen.next ∘ down⟩
#align rand_g.next RandG.next

-- mathport name: «expr .. »
local infixl:41 " .. " => Set.Icc

open Stream'

#print BoundedRandom /-
/-- `bounded_random α` gives us machinery to generate values of type `α` between certain bounds -/
class BoundedRandom (α : Type u) [Preorder α] where
  randomR : ∀ (g) [RandomGen g] (x y : α), x ≤ y → RandG g (x .. y)
#align bounded_random BoundedRandom
-/

#print Random /-
/- ./././Mathport/Syntax/Translate/Command.lean:388:30: infer kinds are unsupported in Lean 4: #[`Random] [] -/
/-- `random α` gives us machinery to generate values of type `α` -/
class Random (α : Type u) where
  Random : ∀ (g : Type) [RandomGen g], RandG g α
#align random Random
-/

/-- shift_31_left = 2^31; multiplying by it shifts the binary
representation of a number left by 31 bits, dividing by it shifts it
right by 31 bits -/
def shift31Left : ℕ := by apply_normed 2 ^ 31
#align shift_31_left shift31Left

namespace Rand

open Stream'

variable (α : Type u)

variable (g : Type) [RandomGen g]

#print Rand.split /-
/-- create a new random number generator distinct from the one stored in the state -/
def split : RandG g g :=
  ⟨Prod.map id up ∘ RandomGen.split ∘ down⟩
#align rand.split Rand.split
-/

variable {g}

section Random

variable [Random α]

export Random (Random)

/-- Generate a random value of type `α`. -/
def random : RandG g α :=
  Random.random α g
#align rand.random Rand.random

/-- generate an infinite series of random values of type `α` -/
def randomSeries : RandG g (Stream' α) := do
  let gen ← Uliftable.up (split g)
  pure <| Stream'.corecState (Random.random α g) gen
#align rand.random_series Rand.randomSeries

end Random

variable {α}

/-- Generate a random value between `x` and `y` inclusive. -/
def randomR [Preorder α] [BoundedRandom α] (x y : α) (h : x ≤ y) : RandG g (x .. y) :=
  BoundedRandom.randomR g x y h
#align rand.random_r Rand.randomR

/-- generate an infinite series of random values of type `α` between `x` and `y` inclusive. -/
def randomSeriesR [Preorder α] [BoundedRandom α] (x y : α) (h : x ≤ y) :
    RandG g (Stream' (x .. y)) := do
  let gen ← Uliftable.up (split g)
  pure <| corec_state (BoundedRandom.randomR g x y h) gen
#align rand.random_series_r Rand.randomSeriesR

end Rand

namespace Io

private def accum_char (w : ℕ) (c : Char) : ℕ :=
  c.toNat + 256 * w
#align io.accum_char io.accum_char

/-- create and seed a random number generator -/
def mkGenerator : Io StdGen := do
  let seed ← Io.rand 0 shift31Left
  return <| mkStdGen seed
#align io.mk_generator Io.mkGenerator

variable {α : Type}

/-- Run `cmd` using a randomly seeded random number generator -/
def runRand (cmd : Rand α) : Io α := do
  let g ← Io.mkGenerator
  return <| (cmd ⟨g⟩).1
#align io.run_rand Io.runRand

/-- Run `cmd` using the provided seed. -/
def runRandWith (seed : ℕ) (cmd : Rand α) : Io α :=
  return <| (cmd.run ⟨mkStdGen seed⟩).1
#align io.run_rand_with Io.runRandWith

section Random

variable [Random α]

/-- randomly generate a value of type α -/
def random : Io α :=
  Io.runRand (Rand.random α)
#align io.random Io.random

/-- randomly generate an infinite series of value of type α -/
def randomSeries : Io (Stream' α) :=
  Io.runRand (Rand.randomSeries α)
#align io.random_series Io.randomSeries

end Random

section BoundedRandom

variable [Preorder α] [BoundedRandom α]

/-- randomly generate a value of type α between `x` and `y` -/
def randomR (x y : α) (p : x ≤ y) : Io (x .. y) :=
  Io.runRand (BoundedRandom.randomR _ x y p)
#align io.random_r Io.randomR

/-- randomly generate an infinite series of value of type α between `x` and `y` -/
def randomSeriesR (x y : α) (h : x ≤ y) : Io (Stream' <| x .. y) :=
  Io.runRand (Rand.randomSeriesR x y h)
#align io.random_series_r Io.randomSeriesR

end BoundedRandom

end Io

namespace Tactic

/-- create a seeded random number generator in the `tactic` monad -/
unsafe def mk_generator : tactic StdGen := do
  tactic.unsafe_run_io @Io.mkGenerator
#align tactic.mk_generator tactic.mk_generator

/-- run `cmd` using the a randomly seeded random number generator
in the tactic monad -/
unsafe def run_rand {α : Type u} (cmd : Rand α) : tactic α := do
  let ⟨g⟩ ← tactic.up mk_generator
  return (cmd ⟨g⟩).1
#align tactic.run_rand tactic.run_rand

variable {α : Type u}

section BoundedRandom

variable [Preorder α] [BoundedRandom α]

/-- Generate a random value between `x` and `y` inclusive. -/
unsafe def random_r (x y : α) (h : x ≤ y) : tactic (x .. y) :=
  run_rand (Rand.randomR x y h)
#align tactic.random_r tactic.random_r

/-- Generate an infinite series of random values of type `α` between `x` and `y` inclusive. -/
unsafe def random_series_r (x y : α) (h : x ≤ y) : tactic (Stream' <| x .. y) :=
  run_rand (Rand.randomSeriesR x y h)
#align tactic.random_series_r tactic.random_series_r

end BoundedRandom

section Random

variable [Random α]

/-- randomly generate a value of type α -/
unsafe def random : tactic α :=
  run_rand (Rand.random α)
#align tactic.random tactic.random

/-- randomly generate an infinite series of value of type α -/
unsafe def random_series : tactic (Stream' α) :=
  run_rand (Rand.randomSeries α)
#align tactic.random_series tactic.random_series

end Random

end Tactic

open Nat (succ one_add mod_eq_of_lt zero_lt_succ add_one succ_le_succ)

variable {g : Type} [RandomGen g]

open Nat

namespace Fin

variable {n : ℕ} [NeZero n]

/-- generate a `fin` randomly -/
protected def random : RandG g (Fin n) :=
  ⟨fun ⟨g⟩ => Prod.map ofNat'' up <| randNat g 0 n⟩
#align fin.random Fin.random

end Fin

open Nat

instance natBoundedRandom : BoundedRandom ℕ
    where randomR g inst x y hxy := do
    let z ← @Fin.random g inst (succ <| y - x) _
    pure
        ⟨z + x, Nat.le_add_left _ _, by
          rw [← le_tsub_iff_right hxy] <;> apply le_of_succ_le_succ z.is_lt⟩
#align nat_bounded_random natBoundedRandom

/-- This `bounded_random` interval generates integers between `x` and
`y` by first generating a natural number between `0` and `y - x` and
shifting the result appropriately. -/
instance intBoundedRandom : BoundedRandom ℤ
    where randomR g inst x y hxy := do
    let ⟨z, h₀, h₁⟩ ← @BoundedRandom.randomR ℕ _ _ g inst 0 (Int.natAbs <| y - x) (by decide)
    pure
        ⟨z + x, Int.le_add_of_nonneg_left (Int.coe_nat_nonneg _),
          Int.add_le_of_le_sub_right <|
            le_trans (Int.ofNat_le_ofNat_of_le h₁)
              (le_of_eq <| Int.ofNat_natAbs_eq_of_nonneg (Int.sub_nonneg_of_le hxy))⟩
#align int_bounded_random intBoundedRandom

instance finRandom (n : ℕ) [NeZero n] : Random (Fin n) where Random g inst := @Fin.random g inst _ _
#align fin_random finRandom

instance finBoundedRandom (n : ℕ) : BoundedRandom (Fin n)
    where randomR g inst (x y : Fin n) p := do
    let ⟨r, h, h'⟩ ← @Rand.randomR ℕ g inst _ _ x.val y.val p
    pure ⟨⟨r, lt_of_le_of_lt h' y⟩, h, h'⟩
#align fin_bounded_random finBoundedRandom

/-- A shortcut for creating a `random (fin n)` instance from
a proof that `0 < n` rather than on matching on `fin (succ n)`  -/
def randomFinOfPos : ∀ {n : ℕ} (h : 0 < n), Random (Fin n)
  | succ n, _ => finRandom _
  | 0, h => False.elim (Nat.not_lt_zero _ h)
#align random_fin_of_pos randomFinOfPos

theorem bool_ofNat_mem_Icc_of_mem_Icc_toNat (x y : Bool) (n : ℕ) :
    n ∈ (x.toNat .. y.toNat) → Bool.ofNat n ∈ (x .. y) :=
  by
  simp only [and_imp, Set.mem_Icc]; intro h₀ h₁
  constructor <;> [have h₂ := Bool.ofNat_le_ofNat h₀, have h₂ := Bool.ofNat_le_ofNat h₁] <;>
      rw [Bool.ofNat_toNat] at h₂ <;>
    exact h₂
#align bool_of_nat_mem_Icc_of_mem_Icc_to_nat bool_ofNat_mem_Icc_of_mem_Icc_toNat

instance : Random Bool
    where Random g inst :=
    (Bool.ofNat ∘ Subtype.val) <$> @BoundedRandom.randomR ℕ _ _ g inst 0 1 (Nat.zero_le _)

instance : BoundedRandom Bool
    where randomR g _inst x y p :=
    Subtype.map Bool.ofNat (bool_ofNat_mem_Icc_of_mem_Icc_toNat x y) <$>
      @BoundedRandom.randomR ℕ _ _ g _inst x.toNat y.toNat (Bool.toNat_le_toNat p)

/-- generate a random bit vector of length `n` -/
def Bitvec.random (n : ℕ) : RandG g (Bitvec n) :=
  Bitvec.ofFin <$> Rand.random (Fin <| 2 ^ n)
#align bitvec.random Bitvec.random

/-- generate a random bit vector of length `n` -/
def Bitvec.randomR {n : ℕ} (x y : Bitvec n) (h : x ≤ y) : RandG g (x .. y) :=
  have h' : ∀ a : Fin (2 ^ n), a ∈ (x.toFin .. y.toFin) → Bitvec.ofFin a ∈ (x .. y) :=
    by
    simp only [and_imp, Set.mem_Icc]; intro z h₀ h₁
    replace h₀ := Bitvec.ofFin_le_ofFin_of_le h₀
    replace h₁ := Bitvec.ofFin_le_ofFin_of_le h₁
    rw [Bitvec.ofFin_toFin] at h₀ h₁; constructor <;> assumption
  Subtype.map Bitvec.ofFin h' <$> Rand.randomR x.toFin y.toFin (Bitvec.toFin_le_toFin_of_le h)
#align bitvec.random_r Bitvec.randomR

open Nat

instance randomBitvec (n : ℕ) : Random (Bitvec n) where Random _ inst := @Bitvec.random _ inst n
#align random_bitvec randomBitvec

instance boundedRandomBitvec (n : ℕ) : BoundedRandom (Bitvec n)
    where randomR _ inst x y p := @Bitvec.randomR _ inst _ _ _ p
#align bounded_random_bitvec boundedRandomBitvec


import Mathbin.Data.Real.Basic
import Mathbin.LinearAlgebra.Matrix.Default
import Lean

attribute [-instance] coeDecidableEq

macro "ℝ" : term =>
  do return Lean.TSyntax.raw (← `(Real))
macro "∑" i:Lean.Parser.Term.funBinder "," t:term : term =>
  do return Lean.TSyntax.raw (← `(Finset.sum Finset.univ (fun $i => $t)))
macro "∑" i:Lean.Parser.Term.funBinder "in" s:term "," t:term : term =>
  do return Lean.TSyntax.raw (← `(Finset.sum $s (fun $i => $t)))
macro "∏" i:Lean.Parser.Term.funBinder "," t:term : term =>
  do return Lean.TSyntax.raw (← `(Finset.prod Finset.univ (fun $i => $t)))
macro "∏" i:Lean.Parser.Term.funBinder "in" s:term "," t:term : term =>
  do return Lean.TSyntax.raw (← `(Finset.prod $s (fun $i => $t)))
macro:75 l:term:75 " ⬝ " r:term:76 : term =>
  do return Lean.TSyntax.raw (← `(Matrix.mul $l $r))
macro:75 l:term:75 " ⬝ᵥ " r:term:76 : term =>
  do return Lean.TSyntax.raw (← `(Matrix.dotProduct $l $r))
macro:50 l:term:50 " ∈ " r:term:51 : term =>
  do return Lean.TSyntax.raw (← `(HasMem.Mem $l $r))
macro:75 l:term:75 " • " r:term:76 : term =>
  do return Lean.TSyntax.raw (← `(HasSmul.smul $l $r))

macro "![" ts:term,* "]" : term => do
  let ts : Array (Lean.TSyntax _) := ts.getElems
  let res ← ts.foldrM (init := ← `(Matrix.vecEmpty)) fun t acc =>
      `(Matrix.vecCons $t $acc)
  return res.raw

section Logic

@[simp] theorem and_left_comm (a b c : Prop) : (a ∧ (b ∧ c)) = (b ∧ (a ∧ c)) := by rw [← and_assoc, and_comm a b, and_assoc]

end Logic

namespace Nat

instance : LE ℕ := { le := Nat.le }

attribute [-instance] Nat.hasSub
instance : Sub ℕ :=
  ⟨Nat.sub⟩

attribute [-instance] Nat.hasAdd
instance : Add ℕ :=
  ⟨Nat.add⟩

attribute [-instance] Nat.hasMul
instance : Mul ℕ :=
  ⟨Nat.mul⟩

attribute [-instance] Nat.inhabited
instance inhabited' : Inhabited ℕ :=
  ⟨Nat.zero⟩

instance decidableEq' : DecidableEq ℕ
  | zero, zero => isTrue rfl
  | succ x, zero => isFalse fun h => Nat.noConfusion h
  | zero, succ y => isFalse fun h => Nat.noConfusion h
  | succ x, succ y =>
    match Nat.decidableEq' x y with
    | Decidable.isTrue xeqy => isTrue (xeqy ▸ Eq.refl (succ x))
    | Decidable.isFalse xney => isFalse fun h => Nat.noConfusion h fun xeqy => absurd xeqy xney

end Nat

namespace Pi

attribute [-instance] Pi.hasZero
instance hasZero' {I : Type} {f : I → Type} [∀ i, Zero (f i)] : Zero (∀ i : I, f i) :=
  ⟨fun _ => Zero.zero⟩

attribute [-instance] Pi.hasOne
instance hasOne' {I : Type} {f : I → Type} [∀ i, One (f i)] : One (∀ i : I, f i) :=
  ⟨fun _ => One.one⟩

end Pi

namespace Bool

attribute [-instance] Bool.inhabited
instance Bool.inhabited' : Inhabited Bool :=
  ⟨false⟩

end Bool

namespace Prod

attribute [-instance] Prod.inhabited
instance Prod.inhabited' [Inhabited α] [Inhabited β] : Inhabited (Prod α β) :=
  ⟨(default, default)⟩

end Prod

namespace List

attribute [-instance] List.inhabited
instance List.inhabited' (α : Type u) : Inhabited (List α) :=
  ⟨List.nil⟩

attribute [-instance] List.hasAppend
instance : Append (List α) :=
  ⟨List.append⟩

end List

namespace Lean

instance (sep) : Coe (Syntax.SepArray sep) (Array Syntax) where
  coe := Syntax.SepArray.getElems

end Lean

section LinearOrder

variable [LinearOrderₓ α]

instance (a b : α) : Decidable (a < b) :=
  LinearOrderₓ.decidableLt a b

instance (a b : α) : Decidable (a ≤ b) :=
  LinearOrderₓ.decidableLe a b

instance (a b : α) : Decidable (a = b) :=
  LinearOrderₓ.decidableEq a b

end LinearOrder

namespace Int

attribute [-instance] Int.decidableLt
instance Int.decidableLt' : LT Int :=
  ⟨Int.Lt⟩

attribute [-instance] Int.linearOrder Int.hasSub

instance Int.hasZero' : Zero ℤ :=
  ⟨ofNat 0⟩

instance Int.hasOne' : One ℤ :=
  ⟨ofNat 1⟩

instance Int.hasSub' : Sub ℤ :=
  ⟨Int.sub⟩

instance Int.hasSAdd' : Add ℤ :=
  ⟨Int.add⟩

instance Decidable.true' : Decidable True :=
  isTrue trivialₓ

instance Decidable.false' : Decidable False :=
  isFalse not_false

def decidableNonneg' (a : ℤ) : Decidable (Nonneg a) :=
  Int.casesOn a (fun a => Decidable.true') fun a => Decidable.false'

instance decidableLe' (a b : ℤ) : Decidable (a ≤ b) :=
  decidableNonneg' (b - a)

instance decidableLt' (a b : ℤ) : Decidable (a < b) :=
  decidableNonneg' (b - (a + ofNat 1))

instance decidableEq' (a b : ℤ) : Decidable (a = b) :=
match a, b with
| ofNat a, ofNat b => by rw [ofNat_eq_ofNat_iff]; apply Nat.decidableEq'
| negSucc a, ofNat b => Decidable.isFalse λ h => by cases h
| ofNat a, negSucc b => Decidable.isFalse λ h => by cases h
| negSucc a, negSucc b => by rw [negSucc_ofNat_inj_iff]; apply Nat.decidableEq'

end Int

def Implies.decidable' [Decidable p] [Decidable q] : Decidable (p → q) :=
  if hp : p then if hq : q then isTrue fun h => hq else isFalse fun h : p → q => absurd (h hp) hq
  else isTrue fun h => absurd h hp

attribute [-instance] Ne.decidable
instance Ne.decidable' {α : Sort u} [DecidableEq α] (a b : α) : Decidable (a ≠ b) :=
  Implies.decidable'


/-
Copyright (c) 2020 Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bhavik Mehta
-/
import category_theory.limits.shapes.terminal
import category_theory.limits.preserves.basic

/-!
# Preserving terminal object

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

Constructions to relate the notions of preserving terminal objects and reflecting terminal objects
to concrete objects.

In particular, we show that `terminal_comparison G` is an isomorphism iff `G` preserves terminal
objects.
-/

universes w v v₁ v₂ u u₁ u₂

noncomputable theory

open category_theory category_theory.category category_theory.limits

variables {C : Type u₁} [category.{v₁} C]
variables {D : Type u₂} [category.{v₂} D]
variables (G : C ⥤ D)

namespace category_theory.limits

variables (X : C)

section terminal

/--
The map of an empty cone is a limit iff the mapped object is terminal.
-/
def is_limit_map_cone_empty_cone_equiv :
  is_limit (G.map_cone (as_empty_cone X)) ≃ is_terminal (G.obj X) :=
is_limit_empty_cone_equiv D _ _ (eq_to_iso rfl)

/-- The property of preserving terminal objects expressed in terms of `is_terminal`. -/
def is_terminal.is_terminal_obj [preserves_limit (functor.empty.{0} C) G]
  (l : is_terminal X) : is_terminal (G.obj X) :=
is_limit_map_cone_empty_cone_equiv G X (preserves_limit.preserves l)

/-- The property of reflecting terminal objects expressed in terms of `is_terminal`. -/
def is_terminal.is_terminal_of_obj [reflects_limit (functor.empty.{0} C) G]
  (l : is_terminal (G.obj X)) : is_terminal X :=
reflects_limit.reflects ((is_limit_map_cone_empty_cone_equiv G X).symm l)

/-- Preserving the terminal object implies preserving all limits of the empty diagram. -/
def preserves_limits_of_shape_pempty_of_preserves_terminal
  [preserves_limit (functor.empty.{0} C) G] : preserves_limits_of_shape (discrete pempty) G :=
{ preserves_limit := λ K,
    preserves_limit_of_iso_diagram G (functor.empty_ext (functor.empty.{0} C) _) }

variables [has_terminal C]
/--
If `G` preserves the terminal object and `C` has a terminal object, then the image of the terminal
object is terminal.
-/
def is_limit_of_has_terminal_of_preserves_limit [preserves_limit (functor.empty.{0} C) G] :
  is_terminal (G.obj (⊤_ C)) :=
terminal_is_terminal.is_terminal_obj G (⊤_ C)

/--
If `C` has a terminal object and `G` preserves terminal objects, then `D` has a terminal object
also.
Note this property is somewhat unique to (co)limits of the empty diagram: for general `J`, if `C`
has limits of shape `J` and `G` preserves them, then `D` does not necessarily have limits of shape
`J`.
-/
lemma has_terminal_of_has_terminal_of_preserves_limit [preserves_limit (functor.empty.{0} C) G] :
  has_terminal D :=
⟨λ F,
begin
  haveI := has_limit.mk ⟨_, is_limit_of_has_terminal_of_preserves_limit G⟩,
  apply has_limit_of_iso F.unique_from_empty.symm,
end⟩

variable [has_terminal D]
/--
If the terminal comparison map for `G` is an isomorphism, then `G` preserves terminal objects.
-/
def preserves_terminal.of_iso_comparison
  [i : is_iso (terminal_comparison G)] : preserves_limit (functor.empty C) G :=
begin
  apply preserves_limit_of_preserves_limit_cone terminal_is_terminal,
  apply (is_limit_map_cone_empty_cone_equiv _ _).symm _,
  apply is_limit.of_point_iso (limit.is_limit (functor.empty.{0} D)),
  apply i,
end

/-- If there is any isomorphism `G.obj ⊤ ⟶ ⊤`, then `G` preserves terminal objects. -/
def preserves_terminal_of_is_iso
  (f : G.obj (⊤_ C) ⟶ ⊤_ D) [i : is_iso f] : preserves_limit (functor.empty C) G :=
begin
  rw subsingleton.elim f (terminal_comparison G) at i,
  exactI preserves_terminal.of_iso_comparison G,
end

/-- If there is any isomorphism `G.obj ⊤ ≅ ⊤`, then `G` preserves terminal objects. -/
def preserves_terminal_of_iso
  (f : G.obj (⊤_ C) ≅ ⊤_ D) : preserves_limit (functor.empty C) G :=
preserves_terminal_of_is_iso G f.hom

variables [preserves_limit (functor.empty.{0} C) G]

/--
If `G` preserves terminal objects, then the terminal comparison map for `G` is an isomorphism.
-/
def preserves_terminal.iso : G.obj (⊤_ C) ≅ ⊤_ D :=
(is_limit_of_has_terminal_of_preserves_limit G).cone_point_unique_up_to_iso (limit.is_limit _)

@[simp]
lemma preserves_terminal.iso_hom : (preserves_terminal.iso G).hom = terminal_comparison G :=
rfl

instance : is_iso (terminal_comparison G) :=
begin
  rw ← preserves_terminal.iso_hom,
  apply_instance,
end

end terminal

section initial

/--
The map of an empty cocone is a colimit iff the mapped object is initial.
-/
def is_colimit_map_cocone_empty_cocone_equiv :
  is_colimit (G.map_cocone (as_empty_cocone.{v₁} X)) ≃ is_initial (G.obj X) :=
is_colimit_empty_cocone_equiv D _ _ (eq_to_iso rfl)

/-- The property of preserving initial objects expressed in terms of `is_initial`. -/
def is_initial.is_initial_obj [preserves_colimit (functor.empty.{0} C) G]
  (l : is_initial X) : is_initial (G.obj X) :=
is_colimit_map_cocone_empty_cocone_equiv G X (preserves_colimit.preserves l)

/-- The property of reflecting initial objects expressed in terms of `is_initial`. -/
def is_initial.is_initial_of_obj [reflects_colimit (functor.empty.{0} C) G]
  (l : is_initial (G.obj X)) : is_initial X :=
reflects_colimit.reflects ((is_colimit_map_cocone_empty_cocone_equiv G X).symm l)

/-- Preserving the initial object implies preserving all colimits of the empty diagram. -/
def preserves_colimits_of_shape_pempty_of_preserves_initial
  [preserves_colimit (functor.empty.{0} C) G] : preserves_colimits_of_shape (discrete pempty) G :=
{ preserves_colimit := λ K,
    preserves_colimit_of_iso_diagram G (functor.empty_ext (functor.empty.{0} C) _) }

variables [has_initial C]
/--
If `G` preserves the initial object and `C` has a initial object, then the image of the initial
object is initial.
-/
def is_colimit_of_has_initial_of_preserves_colimit [preserves_colimit (functor.empty.{0} C) G] :
  is_initial (G.obj (⊥_ C)) :=
initial_is_initial.is_initial_obj G (⊥_ C)

/--
If `C` has a initial object and `G` preserves initial objects, then `D` has a initial object
also.
Note this property is somewhat unique to colimits of the empty diagram: for general `J`, if `C`
has colimits of shape `J` and `G` preserves them, then `D` does not necessarily have colimits of
shape `J`.
-/
lemma has_initial_of_has_initial_of_preserves_colimit [preserves_colimit (functor.empty.{0} C) G] :
  has_initial D :=
⟨λ F,
begin
  haveI := has_colimit.mk ⟨_, is_colimit_of_has_initial_of_preserves_colimit G⟩,
  apply has_colimit_of_iso F.unique_from_empty,
end⟩

variable [has_initial D]
/--
If the initial comparison map for `G` is an isomorphism, then `G` preserves initial objects.
-/
def preserves_initial.of_iso_comparison
  [i : is_iso (initial_comparison G)] : preserves_colimit (functor.empty C) G :=
begin
  apply preserves_colimit_of_preserves_colimit_cocone initial_is_initial,
  apply (is_colimit_map_cocone_empty_cocone_equiv _ _).symm _,
  apply is_colimit.of_point_iso (colimit.is_colimit (functor.empty.{0} D)),
  apply i,
end

/-- If there is any isomorphism `⊥ ⟶ G.obj ⊥`, then `G` preserves initial objects. -/
def preserves_initial_of_is_iso
  (f : ⊥_ D ⟶ G.obj (⊥_ C)) [i : is_iso f] : preserves_colimit (functor.empty C) G :=
begin
  rw subsingleton.elim f (initial_comparison G) at i,
  exactI preserves_initial.of_iso_comparison G,
end

/-- If there is any isomorphism `⊥ ≅ G.obj ⊥ `, then `G` preserves initial objects. -/
def preserves_initial_of_iso
  (f : ⊥_ D ≅ G.obj (⊥_ C)) : preserves_colimit (functor.empty C) G :=
preserves_initial_of_is_iso G f.hom

variables [preserves_colimit (functor.empty.{0} C) G]

/-- If `G` preserves initial objects, then the initial comparison map for `G` is an isomorphism. -/
def preserves_initial.iso : G.obj (⊥_ C) ≅ ⊥_ D :=
(is_colimit_of_has_initial_of_preserves_colimit G).cocone_point_unique_up_to_iso
  (colimit.is_colimit _)

@[simp]
lemma preserves_initial.iso_hom : (preserves_initial.iso G).inv = initial_comparison G :=
rfl

instance : is_iso (initial_comparison G) :=
begin
  rw ← preserves_initial.iso_hom,
  apply_instance,
end

end initial

end category_theory.limits


import data.list.basic
open list
universe u
variables {α : Type} (x y z : α) (xs ys zs : list α)

def mk_symm (xs : list α) := xs ++ reverse xs

theorem reverse_mk_symm (xs : list α) :
  reverse (mk_symm xs) = mk_symm xs :=
  by simp [mk_symm]