import GMLAlgebra.Basic
import GMLAlgebra.Semigroup

namespace Algebra

namespace Semigroup

inductive Expr {α} (xs : List α)
| var : Index xs → Expr xs
| app : Expr xs → Index xs → Expr xs

namespace Expr
variable {α} {xs : List α}

instance instDecidableEq : DecidableEq (Expr xs)
| var i, var j =>
  match inferDecidable (i = j) with
  | isTrue rfl => isTrue rfl
  | isFalse h => isFalse fun | rfl => h rfl
| var _, app _ _ => isFalse Expr.noConfusion
| app _ _, var _ => isFalse Expr.noConfusion
| app a i, app b j =>
  match instDecidableEq a b, inferDecidable (i = j) with
  | isTrue rfl, isTrue rfl => isTrue rfl
  | _, isFalse h => isFalse fun | rfl => h rfl
  | isFalse h, _ => isFalse fun | rfl => h rfl

def lift (x : α) : Expr xs → Expr (x :: xs)
| var i => var (Index.tail i)
| app a i => app (lift x a) (Index.tail i)

def op : Expr xs → Expr xs → Expr xs
| a, var i => app a i
| a, app b i => app (op a b) i

section Eval
variable (s : SemigroupSig α)

def eval {xs : List α} : Expr xs → α
| var i => i.val
| app a i => s.op (eval a) i.val

variable [Semigroup s]

@[simp] theorem eval_lift (x) {xs} : ∀ (a : Expr xs), eval s (lift x a) = eval s a
| var i => by simp [lift, eval]
| app a i => by simp [lift, eval, eval_lift x a]

@[simp] theorem eval_app {xs} (a : Expr xs) (i : Index xs) : eval s (app a i) = s.op (eval s a) i.val := rfl

@[simp] theorem eval_var {xs} (i : Index xs) : eval s (var i) = i.val := rfl

@[simp] theorem eval_op {xs} : ∀ (a b : Expr xs), eval s (op a b) = s.op (eval s a) (eval s b)
| a, var i => rfl
| a, app b i => by simp [eval, eval_op a b, Algebra.op_assoc s.op]

end Eval

section Completeness
variable (xs : List α)

def sig : SemigroupSig (Expr xs) where
  op := Expr.op

protected theorem op_assoc : ∀ (a b c : Expr xs), op (op a b) c = op a (op b c)
| _, _, var _ => rfl
| a, b, app c k => by simp [op, Expr.op_assoc a b c]

instance : Semigroup (Expr.sig xs) where
  op_assoc := Expr.op_assoc xs

end Completeness

end Expr

class Reflect (s : SemigroupSig α) (x : α) (xs : List α) where
  expr : Expr xs
  eval_eq : expr.eval s = x

protected def Reflect.eq (s : SemigroupSig α) (x xs) [inst : Reflect s x xs] : inst.expr.eval s = x := inst.eval_eq

namespace Reflect
variable (s : SemigroupSig α) [Semigroup s]

class Var (x : α) (xs : List α) extends Reflect s x xs

instance (priority:=low) instVarLift (x y : α) (xs : List α) [Var s y xs] : Var s y (x :: xs) where
  expr := Expr.lift x (expr s y)
  eval_eq := by simp [eval_eq]

instance instVarSelf (x : α) (xs : List α) : Var s x (x :: xs) where
  expr := Expr.var Index.head
  eval_eq := by simp

instance instOp (x y : α) {xs : List α} [Reflect s x xs] [Reflect s y xs] : Reflect s (no_index s.op x y) xs where
  expr := Expr.op (expr s x) (expr s y)
  eval_eq := by simp [eval_eq]

end Reflect

theorem reflect {α} (s : SemigroupSig α) [Semigroup s] (xs : List α) {a b : α} [Reflect s a xs] [Reflect s b xs] : Reflect.expr s a (xs:=xs) = Reflect.expr s b → a = b := by
  intro h
  rw [←Reflect.eq s a xs, ←Reflect.eq s b xs, h]

end Semigroup

end Algebra

section Example
open Algebra
variable {α} (s : SemigroupSig α) [Semigroup s] (a b c d : α)

local infix:70 " ⋆ " => s.op

example : (a ⋆ b) ⋆ (c ⋆ d) = a ⋆ ((b ⋆ c) ⋆ d) :=
  Semigroup.reflect s [a,b,c,d] rfl

end Example


import algebra.order.smul

/-! # IMO 2017 A8, Generalized Version -/

namespace IMOSL
namespace IMO2017A8

variables {G : Type*} [linear_ordered_add_comm_group G]

def good (f : G → G) := ∀ x y : G, f x < f y → f x ≤ x + y ∧ x + y ≤ f y

/-- Final solution, part 1 -/
theorem final_solution_part1 [densely_ordered G] : ∀ f : G → G, good f → monotone f :=
begin
  intros f h x y h0,
  rw le_iff_eq_or_lt at h0,
  rcases h0 with rfl | h0,
  exact le_refl (f x),
  rw ← not_lt; intros h1,

  ---- The claim
  have h2 : ∀ z : G, f y - y < z → z < f x - x → (f z = f x ∨ f z = f y) :=
  begin
    intros z h2 h3,
    rcases lt_trichotomy (f z) (f y) with h4 | h4 | h4,
    exfalso; revert h2,
    rw [imp_false, not_lt, le_sub_iff_add_le],
    exact (h z y h4).elim_right,
    right; exact h4,
    rcases lt_trichotomy (f x) (f z) with h5 | h5 | h5,
    exfalso; revert h3,
    rw [imp_false, not_lt, sub_le_iff_le_add'],
    exact (h x z h5).elim_left,
    left; exact h5.symm,
    exfalso; revert h0,
    rw [imp_false, not_lt, ← add_le_add_iff_left z, add_comm z y],
    exact le_trans (h y z h4).elim_right (h z x h5).elim_left
  end,

  ---- Finishing
  rcases exists_between h0 with ⟨z, h3, h4⟩; clear h0,
  obtain (h5 | h5) : f z = f x ∨ f z = f y :=
  begin
    obtain ⟨h5, h6⟩ := h y x h1,
    rw ← sub_le_iff_le_add' at h5,
    rw ← le_sub_iff_add_le at h6,
    exact h2 z (lt_of_le_of_lt h5 h3) (lt_of_lt_of_le h4 h6)
  end,
  { rcases exists_between h3 with ⟨w, h6, h7⟩; clear h3,
    replace h2 := h2 (f z - w) (sub_lt_sub (by rwa h5) (lt_trans h7 h4))
      (by rw h5; exact sub_lt_sub_left h6 (f x)),
    clear h6; cases h2 with h2 h2,
    { rw ← h2 at h1; replace h1 := (h _ _ h1).elim_right,
      revert h1; rw [h2, ← h5, imp_false, not_le, ← sub_lt_iff_lt_add'],
      exact sub_lt_sub_left (lt_trans h7 h4) (f z) },
    { rw [← h2, ← h5] at h1; replace h1 := (h _ _ h1).elim_right,
      revert h1; rw [imp_false, not_le, ← sub_lt_iff_lt_add],
      exact sub_lt_sub_left h7 (f z) } },
  { rcases exists_between h4 with ⟨w, h6, h7⟩; clear h4,
    replace h2 := h2 (f z - w) (by rw h5; exact sub_lt_sub_left h7 (f y))
      (sub_lt_sub (by rwa h5) (lt_trans h3 h6)),
    clear h7; cases h2 with h2 h2,
    { rw [← h2, ← h5] at h1; replace h1 := (h _ _ h1).elim_left,
      revert h1; rw [imp_false, not_le, ← lt_sub_iff_add_lt'],
      exact sub_lt_sub_left h6 (f z) },
    { rw ← h2 at h1; replace h1 := (h _ _ h1).elim_left,
      revert h1; rw [h2, ← h5, imp_false, not_le, ← lt_sub_iff_add_lt],
      exact sub_lt_sub_left (lt_trans h3 h6) (f z) } }
end

/-- Final solution, part 2 -/
theorem final_solution_part2 (h : ¬densely_ordered G) :
  ∃ f : G → G, ¬monotone f ∧ good f :=
begin
  ---- Change non-dense-ordering criterion with existence of a minimal positive element
  replace h : ∃ g : G, 0 < g ∧ ∀ x : G, 0 < x → g ≤ x :=
  begin
    contrapose! h; refine ⟨λ x y h0, _⟩,
    replace h := h (y - x) (sub_pos_of_lt h0),
    clear h0; rcases h with ⟨g, h, h0⟩,
    exact ⟨g + x, lt_add_of_pos_left x h, lt_sub_iff_add_lt.mp h0⟩
  end,

  ---- Given a minimal positive element `g`, construct a good non-monotone function
  rcases h with ⟨g, h, h0⟩,
  refine ⟨λ x : G, ite (x = 0) (2 • g) (ite (x = g) 0 (2 • x)), _, λ x y h1, _⟩,

  ---- Show that the function is not monotone
  { rw monotone; simp_rw not_forall,
    refine ⟨0, g, le_of_lt h, _⟩,
    rw [if_pos rfl, if_neg (ne_of_gt h), if_pos rfl, not_le],
    exact smul_pos two_pos h },

  ---- Show that the function is good
  { dsimp only [] at h1 ⊢,
    rcases eq_or_ne 0 x with rfl | hx0,

    -- Case 1: `x = 0`
    { rw if_pos rfl at h1 ⊢,
      rcases eq_or_ne 0 y with rfl | hy0,
      rw if_pos rfl at h1 ⊢,
      exfalso; exact ne_of_lt h1 rfl,
      rcases eq_or_ne g y with rfl | hyg,
      rw [if_neg hy0.symm, if_pos rfl] at h1 ⊢,
      exfalso; exact lt_asymm h1 (smul_pos two_pos h),
      rw [if_neg hy0.symm, if_neg hyg.symm] at h1 ⊢,
      rw [zero_add, and_comm, two_nsmul, le_add_iff_nonneg_left, two_nsmul, ← le_sub_iff_add_le],
      rw smul_lt_smul_iff_of_pos at h1,
      exacts [⟨le_of_lt (lt_trans h h1), h0 _ (sub_pos_of_lt h1)⟩, two_pos] },
    rw if_neg hx0.symm at h1 ⊢,
    rcases eq_or_ne g x with rfl | hxg,

    -- Case 2: `x = g`
    { rw if_pos rfl at h1 ⊢,
      rcases eq_or_ne 0 y with rfl | hy0,
      rw if_pos rfl at h1 ⊢,
      rw add_zero; exact ⟨le_of_lt h, h0 _ h1⟩,
      rcases eq_or_ne g y with rfl | hyg,
      rw [if_neg hy0.symm, if_pos rfl] at h1 ⊢,
      exfalso; exact lt_irrefl 0 h1,
      rw [if_neg hy0.symm, if_neg hyg.symm] at h1 ⊢,
      rw [two_nsmul, add_le_add_iff_right],
      rw smul_pos_iff_of_pos at h1,
      exacts [⟨le_of_lt (add_pos h h1), h0 y h1⟩, two_pos] },

    -- Case 3: `x ∉ {0, g}`
    { rw if_neg hxg.symm at h1 ⊢,
      rcases eq_or_ne 0 y with rfl | hy0,
      rw if_pos rfl at h1 ⊢,
      rw [add_zero, two_nsmul, add_le_iff_nonpos_left, and_iff_left_of_imp],
      contrapose! h1; exact nsmul_le_nsmul_of_le_right (h0 x h1) 2,
      intros h2; exact le_trans h2 (nsmul_nonneg (le_of_lt h) 2),
      rcases eq_or_ne g y with rfl | hyg,
      rw [if_neg hy0.symm, if_pos rfl] at h1 ⊢,
      rw [two_nsmul, add_le_add_iff_left, ← le_neg_iff_add_nonpos_left],
      rw left.nsmul_neg_iff at h1,
      exact ⟨le_of_lt (lt_trans h1 h), h0 _ (neg_pos.mpr h1)⟩,
      exact two_pos,
      rw [if_neg hy0.symm, if_neg hyg.symm] at h1 ⊢,
      rw [two_nsmul, add_le_add_iff_left, two_nsmul, add_le_add_iff_right, and_self],
      rw smul_lt_smul_iff_of_pos at h1,
      exacts [le_of_lt h1, two_pos] } }
end

/-- Final solution, iff version -/
theorem final_solution_iff : densely_ordered G ↔ ∀ f : G → G, good f → monotone f :=
begin
  refine ⟨λ h, _, λ h, _⟩,
  haveI : densely_ordered G := h,
  exact final_solution_part1,
  contrapose! h; simp_rw [and_comm (good _)],
  exact final_solution_part2 h
end

end IMO2017A8
end IMOSL


/-
Copyright (c) 2020 Bryan Gin-ge Chen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kevin Lacker, Bryan Gin-ge Chen

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

/-!
# Lemmas about nat.prime using `int`s

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

open Nat

namespace Int

#print Int.not_prime_of_int_mul /-
theorem not_prime_of_int_mul {a b : ℤ} {c : ℕ} (ha : 1 < a.natAbs) (hb : 1 < b.natAbs)
    (hc : a * b = (c : ℤ)) : ¬Nat.Prime c :=
  not_prime_mul' (natAbs_mul_natAbs_eq hc) ha hb
#align int.not_prime_of_int_mul Int.not_prime_of_int_mul
-/

/- warning: int.succ_dvd_or_succ_dvd_of_succ_sum_dvd_mul -> Int.succ_dvd_or_succ_dvd_of_succ_sum_dvd_mul is a dubious translation:
lean 3 declaration is
  forall {p : Nat}, (Nat.Prime p) -> (forall {m : Int} {n : Int} {k : Nat} {l : Nat}, (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))) (HPow.hPow.{0, 0, 0} Nat Nat Nat (instHPow.{0, 0} Nat Nat (Monoid.Pow.{0} Nat Nat.monoid)) p k)) m) -> (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))) (HPow.hPow.{0, 0, 0} Nat Nat Nat (instHPow.{0, 0} Nat Nat (Monoid.Pow.{0} Nat Nat.monoid)) p l)) n) -> (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))) (HPow.hPow.{0, 0, 0} Nat Nat Nat (instHPow.{0, 0} Nat Nat (Monoid.Pow.{0} Nat Nat.monoid)) p (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) k l) (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne)))))) (HMul.hMul.{0, 0, 0} Int Int Int (instHMul.{0} Int Int.hasMul) m n)) -> (Or (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))) (HPow.hPow.{0, 0, 0} Nat Nat Nat (instHPow.{0, 0} Nat Nat (Monoid.Pow.{0} Nat Nat.monoid)) p (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) k (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne)))))) m) (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))) (HPow.hPow.{0, 0, 0} Nat Nat Nat (instHPow.{0, 0} Nat Nat (Monoid.Pow.{0} Nat Nat.monoid)) p (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) l (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne)))))) n)))
but is expected to have type
  forall {p : Nat}, (Nat.Prime p) -> (forall {m : Int} {n : Int} {k : Nat} {l : Nat}, (Dvd.dvd.{0} Int Int.instDvdInt (Nat.cast.{0} Int instNatCastInt (HPow.hPow.{0, 0, 0} Nat Nat Nat (instHPow.{0, 0} Nat Nat instPowNat) p k)) m) -> (Dvd.dvd.{0} Int Int.instDvdInt (Nat.cast.{0} Int instNatCastInt (HPow.hPow.{0, 0, 0} Nat Nat Nat (instHPow.{0, 0} Nat Nat instPowNat) p l)) n) -> (Dvd.dvd.{0} Int Int.instDvdInt (Nat.cast.{0} Int instNatCastInt (HPow.hPow.{0, 0, 0} Nat Nat Nat (instHPow.{0, 0} Nat Nat instPowNat) p (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) k l) (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1))))) (HMul.hMul.{0, 0, 0} Int Int Int (instHMul.{0} Int Int.instMulInt) m n)) -> (Or (Dvd.dvd.{0} Int Int.instDvdInt (Nat.cast.{0} Int instNatCastInt (HPow.hPow.{0, 0, 0} Nat Nat Nat (instHPow.{0, 0} Nat Nat instPowNat) p (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) k (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1))))) m) (Dvd.dvd.{0} Int Int.instDvdInt (Nat.cast.{0} Int instNatCastInt (HPow.hPow.{0, 0, 0} Nat Nat Nat (instHPow.{0, 0} Nat Nat instPowNat) p (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) l (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1))))) n)))
Case conversion may be inaccurate. Consider using '#align int.succ_dvd_or_succ_dvd_of_succ_sum_dvd_mul Int.succ_dvd_or_succ_dvd_of_succ_sum_dvd_mulₓ'. -/
theorem succ_dvd_or_succ_dvd_of_succ_sum_dvd_mul {p : ℕ} (p_prime : Nat.Prime p) {m n : ℤ} {k l : ℕ}
    (hpm : ↑(p ^ k) ∣ m) (hpn : ↑(p ^ l) ∣ n) (hpmn : ↑(p ^ (k + l + 1)) ∣ m * n) :
    ↑(p ^ (k + 1)) ∣ m ∨ ↑(p ^ (l + 1)) ∣ n :=
  have hpm' : p ^ k ∣ m.natAbs := Int.coe_nat_dvd.1 <| Int.dvd_natAbs.2 hpm
  have hpn' : p ^ l ∣ n.natAbs := Int.coe_nat_dvd.1 <| Int.dvd_natAbs.2 hpn
  have hpmn' : p ^ (k + l + 1) ∣ m.natAbs * n.natAbs := by
    rw [← Int.natAbs_mul] <;> apply Int.coe_nat_dvd.1 <| Int.dvd_natAbs.2 hpmn
  let hsd := Nat.succ_dvd_or_succ_dvd_of_succ_sum_dvd_mul p_prime hpm' hpn' hpmn'
  hsd.elim (fun hsd1 => Or.inl (by apply Int.dvd_natAbs.1; apply Int.coe_nat_dvd.2 hsd1))
    fun hsd2 => Or.inr (by apply Int.dvd_natAbs.1; apply Int.coe_nat_dvd.2 hsd2)
#align int.succ_dvd_or_succ_dvd_of_succ_sum_dvd_mul Int.succ_dvd_or_succ_dvd_of_succ_sum_dvd_mul

/- warning: int.prime.dvd_nat_abs_of_coe_dvd_sq -> Int.Prime.dvd_natAbs_of_coe_dvd_sq is a dubious translation:
lean 3 declaration is
  forall {p : Nat}, (Nat.Prime p) -> (forall (k : 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))) p) (HPow.hPow.{0, 0, 0} Int Nat Int (instHPow.{0, 0} Int Nat (Monoid.Pow.{0} Int Int.monoid)) k (OfNat.ofNat.{0} Nat 2 (OfNat.mk.{0} Nat 2 (bit0.{0} Nat Nat.hasAdd (One.one.{0} Nat Nat.hasOne)))))) -> (Dvd.Dvd.{0} Nat Nat.hasDvd p (Int.natAbs k)))
but is expected to have type
  forall {p : Nat}, (Nat.Prime p) -> (forall (k : Int), (Dvd.dvd.{0} Int Int.instDvdInt (Nat.cast.{0} Int instNatCastInt p) (HPow.hPow.{0, 0, 0} Int Nat Int (instHPow.{0, 0} Int Nat (Monoid.Pow.{0} Int Int.instMonoidInt)) k (OfNat.ofNat.{0} Nat 2 (instOfNatNat 2)))) -> (Dvd.dvd.{0} Nat Nat.instDvdNat p (Int.natAbs k)))
Case conversion may be inaccurate. Consider using '#align int.prime.dvd_nat_abs_of_coe_dvd_sq Int.Prime.dvd_natAbs_of_coe_dvd_sqₓ'. -/
theorem Prime.dvd_natAbs_of_coe_dvd_sq {p : ℕ} (hp : p.Prime) (k : ℤ) (h : ↑p ∣ k ^ 2) :
    p ∣ k.natAbs := by
  apply @Nat.Prime.dvd_of_dvd_pow _ _ 2 hp
  rwa [sq, ← nat_abs_mul, ← coe_nat_dvd_left, ← sq]
#align int.prime.dvd_nat_abs_of_coe_dvd_sq Int.Prime.dvd_natAbs_of_coe_dvd_sq

end Int


/-
Copyright (c) 2018 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl

The role of this file is twofold. In the first part there are theorems of the following
form: if α has a group structure and α ≃ β then β has a group structure, and
similarly for monoids, semigroups, rings, integral domains, fields and so on.

In the second part there are extensions of equiv called add_equiv,
mul_equiv, and ring_equiv, which are datatypes representing isomorphisms
of monoids, groups and rings.

-/
import data.equiv.basic algebra.field

universes u v w x
variables {α : Type u} {β : Type v} {γ : Type w} {δ : Type x}

namespace equiv

section group
variables [group α]

protected def mul_left (a : α) : α ≃ α :=
{ to_fun    := λx, a * x,
  inv_fun   := λx, a⁻¹ * x,
  left_inv  := assume x, show a⁻¹ * (a * x) = x, from inv_mul_cancel_left a x,
  right_inv := assume x, show a * (a⁻¹ * x) = x, from mul_inv_cancel_left a x }

attribute [to_additive equiv.add_left._proof_1] equiv.mul_left._proof_1
attribute [to_additive equiv.add_left._proof_2] equiv.mul_left._proof_2
attribute [to_additive equiv.add_left] equiv.mul_left

protected def mul_right (a : α) : α ≃ α :=
{ to_fun    := λx, x * a,
  inv_fun   := λx, x * a⁻¹,
  left_inv  := assume x, show (x * a) * a⁻¹ = x, from mul_inv_cancel_right x a,
  right_inv := assume x, show (x * a⁻¹) * a = x, from inv_mul_cancel_right x a }

attribute [to_additive equiv.add_right._proof_1] equiv.mul_right._proof_1
attribute [to_additive equiv.add_right._proof_2] equiv.mul_right._proof_2
attribute [to_additive equiv.add_right] equiv.mul_right

protected def inv (α) [group α] : α ≃ α :=
{ to_fun    := λa, a⁻¹,
  inv_fun   := λa, a⁻¹,
  left_inv  := assume a, inv_inv a,
  right_inv := assume a, inv_inv a }

attribute [to_additive equiv.neg._proof_1] equiv.inv._proof_1
attribute [to_additive equiv.neg._proof_2] equiv.inv._proof_2
attribute [to_additive equiv.neg] equiv.inv

def units_equiv_ne_zero (α : Type*) [field α] : units α ≃ {a : α | a ≠ 0} :=
⟨λ a, ⟨a.1, units.ne_zero _⟩, λ a, units.mk0 _ a.2, λ ⟨_, _, _, _⟩, units.ext rfl, λ ⟨_, _⟩, rfl⟩

@[simp] lemma coe_units_equiv_ne_zero [field α] (a : units α) :
  ((units_equiv_ne_zero α a) : α) = a := rfl

end group

section instances

variables (e : α ≃ β)

protected def has_zero [has_zero β] : has_zero α := ⟨e.symm 0⟩
lemma zero_def [has_zero β] : @has_zero.zero _ (equiv.has_zero e) = e.symm 0 := rfl

protected def has_one [has_one β] : has_one α := ⟨e.symm 1⟩
lemma one_def [has_one β] : @has_one.one _ (equiv.has_one e) = e.symm 1 := rfl

protected def has_mul [has_mul β] : has_mul α := ⟨λ x y, e.symm (e x * e y)⟩
lemma mul_def [has_mul β] (x y : α) :
  @has_mul.mul _ (equiv.has_mul e) x y = e.symm (e x * e y) := rfl

protected def has_add [has_add β] : has_add α := ⟨λ x y, e.symm (e x + e y)⟩
lemma add_def [has_add β] (x y : α) :
  @has_add.add _ (equiv.has_add e) x y = e.symm (e x + e y) := rfl

protected def has_inv [has_inv β] : has_inv α := ⟨λ x, e.symm (e x)⁻¹⟩
lemma inv_def [has_inv β] (x : α) : @has_inv.inv _ (equiv.has_inv e) x = e.symm (e x)⁻¹ := rfl

protected def has_neg [has_neg β] : has_neg α := ⟨λ x, e.symm (-e x)⟩
lemma neg_def [has_neg β] (x : α) : @has_neg.neg _ (equiv.has_neg e) x = e.symm (-e x) := rfl

protected def semigroup [semigroup β] : semigroup α :=
{ mul_assoc := by simp [mul_def, mul_assoc],
  ..equiv.has_mul e }

protected def comm_semigroup [comm_semigroup β] : comm_semigroup α :=
{ mul_comm := by simp [mul_def, mul_comm],
  ..equiv.semigroup e }

protected def monoid [monoid β] : monoid α :=
{ one_mul := by simp [mul_def, one_def],
  mul_one := by simp [mul_def, one_def],
  ..equiv.semigroup e,
  ..equiv.has_one e }

protected def comm_monoid [comm_monoid β] : comm_monoid α :=
{ ..equiv.comm_semigroup e,
  ..equiv.monoid e }

protected def group [group β] : group α :=
{ mul_left_inv := by simp [mul_def, inv_def, one_def],
  ..equiv.monoid e,
  ..equiv.has_inv e }

protected def comm_group [comm_group β] : comm_group α :=
{ ..equiv.group e,
  ..equiv.comm_semigroup e }

protected def add_semigroup [add_semigroup β] : add_semigroup α :=
@additive.add_semigroup _ (@equiv.semigroup _ _ e multiplicative.semigroup)

protected def add_comm_semigroup [add_comm_semigroup β] : add_comm_semigroup α :=
@additive.add_comm_semigroup _ (@equiv.comm_semigroup _ _ e multiplicative.comm_semigroup)

protected def add_monoid [add_monoid β] : add_monoid α :=
@additive.add_monoid _ (@equiv.monoid _ _ e multiplicative.monoid)

protected def add_comm_monoid [add_comm_monoid β] : add_comm_monoid α :=
@additive.add_comm_monoid _ (@equiv.comm_monoid _ _ e multiplicative.comm_monoid)

protected def add_group [add_group β] : add_group α :=
@additive.add_group _ (@equiv.group _ _ e multiplicative.group)

protected def add_comm_group [add_comm_group β] : add_comm_group α :=
@additive.add_comm_group _ (@equiv.comm_group _ _ e multiplicative.comm_group)

protected def semiring [semiring β] : semiring α :=
{ right_distrib := by simp [mul_def, add_def, add_mul],
  left_distrib := by simp [mul_def, add_def, mul_add],
  zero_mul := by simp [mul_def, zero_def],
  mul_zero := by simp [mul_def, zero_def],
  ..equiv.has_zero e,
  ..equiv.has_mul e,
  ..equiv.has_add e,
  ..equiv.monoid e,
  ..equiv.add_comm_monoid e }

protected def comm_semiring [comm_semiring β] : comm_semiring α :=
{ ..equiv.semiring e,
  ..equiv.comm_monoid e }

protected def ring [ring β] : ring α :=
{ ..equiv.semiring e,
  ..equiv.add_comm_group e }

protected def comm_ring [comm_ring β] : comm_ring α :=
{ ..equiv.comm_monoid e,
  ..equiv.ring e }

protected def zero_ne_one_class [zero_ne_one_class β] : zero_ne_one_class α :=
{ zero_ne_one := by simp [zero_def, one_def],
  ..equiv.has_zero e,
  ..equiv.has_one e }

protected def nonzero_comm_ring [nonzero_comm_ring β] : nonzero_comm_ring α :=
{ ..equiv.zero_ne_one_class e,
  ..equiv.comm_ring e }

protected def domain [domain β] : domain α :=
{ eq_zero_or_eq_zero_of_mul_eq_zero := by simp [mul_def, zero_def, equiv.eq_symm_apply],
  ..equiv.has_zero e,
  ..equiv.zero_ne_one_class e,
  ..equiv.has_mul e,
  ..equiv.ring e }

protected def integral_domain [integral_domain β] : integral_domain α :=
{ ..equiv.domain e,
  ..equiv.nonzero_comm_ring e }

protected def division_ring [division_ring β] : division_ring α :=
{ inv_mul_cancel := λ _,
    by simp [mul_def, inv_def, zero_def, one_def, (equiv.symm_apply_eq _).symm];
      exact inv_mul_cancel,
  mul_inv_cancel := λ _,
    by simp [mul_def, inv_def, zero_def, one_def, (equiv.symm_apply_eq _).symm];
      exact mul_inv_cancel,
  ..equiv.has_zero e,
  ..equiv.has_one e,
  ..equiv.domain e,
  ..equiv.has_inv e }

protected def field [field β] : field α :=
{ ..equiv.integral_domain e,
  ..equiv.division_ring e }

protected def discrete_field [discrete_field β] : discrete_field α :=
{ has_decidable_eq := equiv.decidable_eq e,
  inv_zero := by simp [mul_def, inv_def, zero_def],
  ..equiv.has_mul e,
  ..equiv.has_inv e,
  ..equiv.has_zero e,
  ..equiv.field e }

end instances
end equiv

structure add_equiv (α β : Type*) [has_add α] [has_add β] extends α ≃ β :=
(hom : is_add_hom to_fun)

infix ` ≃+ `:50 := add_equiv

namespace add_equiv

variables [has_add α] [has_add β] [has_add γ]

@[refl] def refl (α : Type) [has_add α] : α ≃+ α :=
{ hom := is_add_hom.id
  ..equiv.refl _}

@[symm] def symm (h : α ≃+ β) : β ≃+ α :=
{ hom := ⟨λ n₁ n₂, function.injective_of_left_inverse h.left_inv begin
   rw h.hom.map_add, unfold equiv.symm, rw [h.right_inv, h.right_inv, h.right_inv], end⟩
  ..h.to_equiv.symm}

@[trans] def trans (h1 : α ≃+ β) (h2 : β ≃+ γ) : (α ≃+ γ) :=
{ hom := is_add_hom.comp h1.hom h2.hom,
  ..equiv.trans h1.to_equiv h2.to_equiv }

end add_equiv

structure mul_equiv (α β : Type*) [has_mul α] [has_mul β] extends α ≃ β :=
(hom : is_mul_hom to_fun)

infix ` ≃* `:50 := mul_equiv

namespace mul_equiv

variables [has_mul α] [has_mul β] [has_mul γ]

@[refl] def refl (α : Type*) [has_mul α] : α ≃* α :=
{ hom := ⟨λ _ _,rfl⟩,
..equiv.refl _}

@[symm] def symm (h : α ≃* β) : β ≃* α :=
{ hom := ⟨λ n₁ n₂, function.injective_of_left_inverse h.left_inv begin
   rw h.hom.map_mul, unfold equiv.symm, rw [h.right_inv, h.right_inv, h.right_inv], end⟩
  ..h.to_equiv.symm}

@[trans] def trans (h1 : α ≃* β) (h2 : β ≃* γ) : (α ≃* γ) :=
{ hom := is_mul_hom.comp h1.hom h2.hom,
  ..equiv.trans h1.to_equiv h2.to_equiv }

end mul_equiv

-- equiv of monoids
namespace mul_equiv

variables [monoid α] [monoid β] [monoid γ]

lemma one (h : equiv α β) (hom : ∀ x y, h (x * y) = h x * h y) :
  h 1 = 1 :=
by rw [←mul_one (h 1), ←h.apply_symm_apply 1, ←hom]; simp

instance is_monoid_hom (h : α ≃* β) : is_monoid_hom h.to_equiv := {
  map_one := mul_equiv.one h.to_equiv h.hom.map_mul,
  map_mul := h.hom.map_mul }

instance (h : α ≃* β) : is_mul_hom h.to_equiv := {map_mul := λ a b, is_monoid_hom.map_mul h.to_equiv}
end mul_equiv

-- equiv of groups
namespace mul_equiv

variables [group α] [group β] [group γ]

instance is_group_hom (h : α ≃* β) : is_group_hom h.to_equiv := ⟨h.hom.map_mul⟩

end mul_equiv

-- equiv of add_groups
namespace add_equiv

variables [add_group α] [add_group β] [add_group γ]

instance is_add_group_hom (h : α ≃+ β) : is_add_group_hom h.to_equiv := ⟨h.hom.map_add⟩

end add_equiv

namespace units

variables [monoid α] [monoid β] [monoid γ]
(f : α → β) (g : β → γ) [is_monoid_hom f] [is_monoid_hom g]

def map_equiv (h : α ≃* β) : units α ≃* units β :=
{ to_fun := map h.to_equiv,
  inv_fun := map h.symm.to_equiv,
  left_inv := λ u, ext $ h.left_inv u,
  right_inv := λ u, ext $ h.right_inv u,
  hom := ⟨λ a b, units.ext $ is_mul_hom.map_mul h.to_equiv⟩}

end units

structure ring_equiv (α β : Type*) [ring α] [ring β] extends α ≃ β :=
(hom : is_ring_hom to_fun)

infix ` ≃r `:50 := ring_equiv

namespace ring_equiv

variables [ring α] [ring β] [ring γ]

instance {e : α ≃r β} : is_ring_hom e.to_equiv := hom _

protected def refl (α : Type*) [ring α] : α ≃r α :=
{ hom := is_ring_hom.id, .. equiv.refl α }

protected def symm {α β : Type*} [ring α] [ring β] (e : α ≃r β) : β ≃r α :=
{ hom := ⟨(equiv.symm_apply_eq _).2 e.hom.1.symm,
    λ x y, (equiv.symm_apply_eq _).2 $ show _ = e.to_equiv.to_fun _, by rw [e.2.2, e.1.4, e.1.4],
    λ x y, (equiv.symm_apply_eq _).2 $ show _ = e.to_equiv.to_fun _, by rw [e.2.3, e.1.4, e.1.4]⟩,
  .. e.to_equiv.symm }

protected def trans {α β γ : Type*} [ring α] [ring β] [ring γ]
  (e₁ : α ≃r β) (e₂ : β ≃r γ) : α ≃r γ :=
{ hom := is_ring_hom.comp _ _, .. e₁.1.trans e₂.1  }

instance symm.is_ring_hom {e : α ≃r β} : is_ring_hom e.to_equiv.symm := hom e.symm

@[simp] lemma to_equiv_symm (e : α ≃r β) : e.symm.to_equiv = e.to_equiv.symm := rfl

@[simp] lemma to_equiv_symm_apply (e : α ≃r β) (x : β) :
  e.symm.to_equiv x = e.to_equiv.symm x := rfl

end ring_equiv


open classical

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

example : α → ((∀ x : α, r) ↔ r) :=
assume a : α,
show (∀ x : α, r) ↔ r, from
iff.intro
    (assume : (∀ x : α, r),
        show r, from
        this a)
    (assume : r,
        show (∀ x : α, r), from
        assume b : α, this)

example : (∀ x, p x ∨ r) ↔ (∀ x, p x) ∨ r :=
iff.intro
    (assume h : (∀ x, p x ∨ r),
        show (∀ x, p x) ∨ r, from
        or.elim (em r)
            or.inr
            (assume hnr : ¬r,
                or.inl (assume z : α, (
                    or.elim (h z)
                        id
                        (assume hr : r, absurd hr hnr)))))
    (assume h : (∀ x, p x) ∨ r,
        show (∀ x, p x ∨ r), from
        assume z : α,
        or.elim h
            (assume hl : (∀ x, p x),
                or.inl (hl z))
            (assume hr : r,
                or.inr hr))

example : (∀ x, r → p x) ↔ (r → ∀ x, p x) :=
iff.intro
    (assume h : (∀ x, r → p x),
        show (r → ∀ x, p x), from
        assume hr : r,
        show (∀ x, p x), from
        assume z : α,
        (h z) hr)
    (assume h : r → ∀ x, p x,
        show ∀ x, r → p x, from
        assume z : α,
        assume hr : r,
        h hr z)


/-
Copyright (c) 2019 Scott Morrison All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison

! This file was ported from Lean 3 source module category_theory.core
! leanprover-community/mathlib commit 23aa88e32dcc9d2a24cca7bc23268567ed4cd7d6
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Control.EquivFunctor
import Mathbin.CategoryTheory.Groupoid
import Mathbin.CategoryTheory.Whiskering
import Mathbin.CategoryTheory.Types

/-!
# The core of a category

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

The core of a category `C` is the (non-full) subcategory of `C` consisting of all objects,
and all isomorphisms. We construct it as a `groupoid`.

`core.inclusion : core C ⥤ C` gives the faithful inclusion into the original category.

Any functor `F` from a groupoid `G` into `C` factors through `core C`,
but this is not functorial with respect to `F`.
-/

namespace CategoryTheory

universe v₁ v₂ u₁ u₂

#print CategoryTheory.Core /-
-- morphism levels before object levels. See note [category_theory universes].
/-- The core of a category C is the groupoid whose morphisms are all the
isomorphisms of C. -/
@[nolint has_nonempty_instance]
def Core (C : Type u₁) :=
  C
#align category_theory.core CategoryTheory.Core
-/

variable {C : Type u₁} [Category.{v₁} C]

#print CategoryTheory.coreCategory /-
instance coreCategory : Groupoid.{v₁} (Core C)
    where
  Hom := fun X Y : C => X ≅ Y
  inv X Y f := Iso.symm f
  id X := Iso.refl X
  comp X Y Z f g := Iso.trans f g
#align category_theory.core_category CategoryTheory.coreCategory
-/

namespace Core

#print CategoryTheory.Core.id_hom /-
@[simp]
theorem id_hom (X : Core C) : Iso.hom (𝟙 X) = 𝟙 X :=
  rfl
#align category_theory.core.id_hom CategoryTheory.Core.id_hom
-/

#print CategoryTheory.Core.comp_hom /-
@[simp]
theorem comp_hom {X Y Z : Core C} (f : X ⟶ Y) (g : Y ⟶ Z) : (f ≫ g).Hom = f.Hom ≫ g.Hom :=
  rfl
#align category_theory.core.comp_hom CategoryTheory.Core.comp_hom
-/

variable (C)

#print CategoryTheory.Core.inclusion /-
/-- The core of a category is naturally included in the category. -/
def inclusion : Core C ⥤ C where
  obj := id
  map X Y f := f.Hom
#align category_theory.core.inclusion CategoryTheory.Core.inclusion
-/

instance : Faithful (inclusion C) where

variable {C} {G : Type u₂} [Groupoid.{v₂} G]

#print CategoryTheory.Core.functorToCore /-
-- Note that this function is not functorial
-- (consider the two functors from [0] to [1], and the natural transformation between them).
/-- A functor from a groupoid to a category C factors through the core of C. -/
noncomputable def functorToCore (F : G ⥤ C) : G ⥤ Core C
    where
  obj X := F.obj X
  map X Y f := ⟨F.map f, F.map (inv f)⟩
#align category_theory.core.functor_to_core CategoryTheory.Core.functorToCore
-/

#print CategoryTheory.Core.forgetFunctorToCore /-
/-- We can functorially associate to any functor from a groupoid to the core of a category `C`,
a functor from the groupoid to `C`, simply by composing with the embedding `core C ⥤ C`.
-/
def forgetFunctorToCore : (G ⥤ Core C) ⥤ G ⥤ C :=
  (whiskeringRight _ _ _).obj (inclusion C)
#align category_theory.core.forget_functor_to_core CategoryTheory.Core.forgetFunctorToCore
-/

end Core

#print CategoryTheory.ofEquivFunctor /-
/-- `of_equiv_functor m` lifts a type-level `equiv_functor`
to a categorical functor `core (Type u₁) ⥤ core (Type u₂)`.
-/
def ofEquivFunctor (m : Type u₁ → Type u₂) [EquivFunctor m] : Core (Type u₁) ⥤ Core (Type u₂)
    where
  obj := m
  map α β f := (EquivFunctor.mapEquiv m f.toEquiv).toIso
  -- These are not very pretty.
  map_id' α := by ext; exact congr_fun (EquivFunctor.map_refl _) x
  map_comp' α β γ f g := by
    ext
    simp only [EquivFunctor.mapEquiv_apply, Equiv.toIso_hom, Function.comp_apply, core.comp_hom,
      types_comp]
    erw [iso.to_equiv_comp, EquivFunctor.map_trans]
#align category_theory.of_equiv_functor CategoryTheory.ofEquivFunctor
-/

end CategoryTheory


import .atom

variables {α β : Type}

open atom_type list

/-
Requires : nqfree arg-0
-/
def dnf : fm α → list (list α)
| (fm.true α) := [[]]
| (fm.false α) := []
| (fm.atom a) := [[a]]
| (fm.and p q) := list.map list.append_pair $ list.product (dnf p) (dnf q)
| (fm.or p q) := dnf p ++ dnf q
| (fm.ex _) := []
| (fm.not _) := []

lemma dnf_prsv_pred [atom_type α β] (pr : α → Prop) :
  ∀ (φ : fm α), list.allp pr (@atoms _ (atom_type.dec_eq _ β) φ) → list.allp (list.allp pr) (dnf φ)
| (fm.true α) hnm :=
  begin
    intros as has, unfold dnf at has, simp,
    rewrite list.mem_singleton at has, subst has,
    apply list.forall_mem_nil
  end
| (fm.false α) hnm :=
  begin simp, unfold dnf, intros a ha, cases ha end
| (fm.atom a) hnm :=
  begin
    intros as has, unfold dnf at has,
    rewrite mem_singleton at has,
    subst has, intros a' ha',
    rewrite mem_singleton at ha',
    subst ha', apply hnm, apply or.inl rfl
  end
| (fm.and p q) hnm :=
  begin
    unfold atoms at hnm,
    rewrite allp_iff_forall_mem at hnm,
    rewrite forall_mem_union at hnm,
    cases hnm with hnmp hnmq,
    unfold dnf, intros as has, intros a ha,
    rewrite mem_map at has,
    cases has with asp hasp,
    cases hasp with hasp1 hasp2,
    cases asp with as1 as2, subst hasp2,
    simp at ha, cases ha with hm hm,
    apply dnf_prsv_pred p hnmp as1,
    apply fst_mem_of_mem_product hasp1, apply hm,
    apply dnf_prsv_pred q hnmq as2,
    apply snd_mem_of_mem_product hasp1, apply hm
  end
| (fm.or p q) hnm :=
  begin
    unfold atoms at hnm,
    rewrite allp_iff_forall_mem at hnm,
    rewrite forall_mem_union at hnm,
    cases hnm with hnmp hnmq,
    unfold dnf, intros as has, intros a ha,
    rewrite mem_append at has,
    cases has with hm hm,
    apply dnf_prsv_pred p hnmp as hm a ha,
    apply dnf_prsv_pred q hnmq as hm a ha
  end
| (fm.not _) hnm :=
  begin
    rewrite allp_iff_forall_mem,
    unfold dnf, apply @forall_mem_nil _ (allp pr),
  end
| (fm.ex _) hnm :=
  begin
    rewrite allp_iff_forall_mem,
    unfold dnf, apply @forall_mem_nil _ (allp pr),
  end

lemma dnf_prsv_normal [atom_type α β] : ∀ (p : fm α),
  fnormal β p → list.allp (list.allp (normal β)) (dnf p) :=
begin
  intros p hp, rewrite fnormal_iff_fnormal_alt at hp,
  apply dnf_prsv_pred (normal β) _ hp,
end

lemma dnf_prsv [atom_type α β] : ∀ {p : fm α} {bs : list β},
  nqfree p → (list.some_true (list.map (allp (atom_type.val bs)) (dnf p)) ↔ I p bs)
| (fm.true α) bs hf :=
  begin
    unfold dnf, unfold map, unfold I,
    unfold interp, simp, existsi true, simp
  end
| (fm.false α) bs hf :=
  begin
    unfold dnf, unfold map, unfold I,
    unfold interp, simp, intro hc, cases hc with p hp,
    cases hp with hp1 hp2, cases hp1
  end
| (fm.atom a) bs hf :=
  begin
    unfold dnf, unfold map, unfold I,
    unfold interp, simp, unfold some_true,
    apply iff.intro; intro h, cases h with p hp,
    cases hp with hp1 hp2, rewrite mem_singleton at hp1,
    subst hp1, apply hp2, existsi (val bs a), simp, apply h
  end
| (p ∧' q) bs hf :=
  begin
    cases hf with hfp hfq, unfold dnf,
    unfold some_true, rewrite map_compose,
    rewrite exp_I_and,
    rewrite iff.symm (@dnf_prsv p bs hfp),
    rewrite iff.symm (@dnf_prsv q bs hfq),
    apply iff.intro; intro h,

    cases h with r hr, cases hr with hr1 hr2,
    rewrite mem_map at hr1, cases hr1 with ll hll,
    cases hll with hll1 hll2, subst hll2, cases ll with lp lq,
    unfold append_pair at hr2, rewrite mem_product at hll1,
    cases hll1 with hlp hlq, unfold allp at hr2,
    rewrite forall_mem_append at hr2, cases hr2 with hp hq,
    apply and.intro,
    existsi (allp (val bs) lp),
    apply and.intro (mem_map_of_mem _ hlp) hp,
    existsi (allp (val bs) lq),
    apply and.intro (mem_map_of_mem _ hlq) hq,

    cases h with hp hq,
    cases hp with cp hcp, cases hcp with hcp1 hcp2,
    cases hq with cq hcq, cases hcq with hcq1 hcq2,
    rewrite mem_map at hcp1, cases hcp1 with lp hlp,
    cases hlp with hlp1 hlp2, subst hlp2,
    rewrite mem_map at hcq1, cases hcq1 with lq hlq,
    cases hlq with hlq1 hlq2, subst hlq2,
    existsi (allp (val bs) (lp ++ lq)), apply and.intro,
    rewrite mem_map, existsi (lp,lq), apply and.intro,
    rewrite mem_product, apply and.intro; assumption,
    refl, unfold allp, rewrite forall_mem_append,
    apply and.intro hcp2 hcq2
  end
| (p ∨' q) bs hf :=
  begin
    cases hf with hfp hfq,
    unfold dnf, rewrite map_append, rewrite some_true_append,
    rewrite @dnf_prsv p _ hfp, rewrite @dnf_prsv q _ hfq, rewrite exp_I_or,
  end
| (fm.not _) bs hf := by cases hf
| (fm.ex _) bs hf := by cases hf


/-
Copyright (c) 2020 Aaron Anderson, Jalex Stark, Kyle Miller. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Aaron Anderson, Jalex Stark, Kyle Miller.
-/
import data.fintype.basic
import .sym2
import tactic

open finset
-- noncomputable theory

/-!
# Simple graphs

This module defines simple graphs on a vertex type `V` as an
irreflexive symmetric relation.

There is a basic API for locally finite graphs and for graphs with
finitely many vertices.

## Main definitions

* `simple_graph` is a structure for symmetric, irreflexive relations

* `neighbor_set` is the `set` of vertices adjacent to a given vertex

* `neighbor_finset` is the `finset` of vertices adjacent to a given vertex,
   if `neighbor_set` is finite

## Implementation notes

* A locally finite graph is one with instances `∀ v, fintype (G.neighbor_set v)`.

* Given instances `decidable_rel G.adj` and `fintype V`, then the graph
is locally finite, too.

TODO: This is the simplest notion of an unoriented graph.  This should
eventually fit into a more complete combinatorics hierarchy which
includes multigraphs and directed graphs.  We begin with simple graphs
in order to start learning what the combinatorics hierarchy should
look like.

TODO: Part of this would include defining, for example, subgraphs of a
simple graph.

-/

universe u
variables (V : Type u)
/--
A simple graph is an irreflexive symmetric relation `adj` on a vertex type `V`.
The relation describes which pairs of vertices are adjacent.
There is exactly one edge for every pair of adjacent edges;
see `simple_graph.E` for the corresponding type of edges.

Note: The type of the relation is given as `V → set V` rather than
`V → V → Prop` so that, given vertices `v` and `w`, then `w ∈ G.adj v`
works as another way to write `G.adj v w`.  Otherwise Lean cannot find
a `has_mem` instance.
-/
@[ext] structure simple_graph :=
(adj : V → V → Prop)
(sym : symmetric adj . obviously)
(loopless : irreflexive adj . obviously)
namespace simple_graph

/--
The complete graph on a type `V` is the simple graph with all pairs of distinct vertices adjacent.
-/
variables {V} (G : simple_graph V)

def complete_graph : simple_graph V :=
{ adj := ne }

def empty : simple_graph V :=
{ adj := λ _ _, false}

-- @[simp] lemma empty_adj (v u : V) : (@empty V).adj v u ↔ false := by tidy

instance : inhabited (simple_graph V) :=
⟨@complete_graph V⟩

instance complete_graph_adj_decidable (V : Type u) [decidable_eq V] :
  decidable_rel (@complete_graph V).adj :=
by { dsimp [complete_graph], apply_instance }

-- variables {V} (G : simple_graph V)

/-- `G.neighbor_set v` is the set of vertices adjacent to `v` in `G`. -/
def neighbor_set (v : V) : set V := set_of (G.adj v)

lemma ne_of_edge {a b : V} (hab : G.adj a b) : a ≠ b :=
by { rintro rfl, exact G.loopless a hab }

/--
The edges of G consist of the unordered pairs of vertices related by
`G.adj`.  It is given as a subtype of the symmetric square.
-/
def E : Type u := {x : sym2 V // x ∈ sym2.from_rel G.sym}

/-- Allows us to refer to a vertex being a member of an edge. -/
instance has_mem : has_mem V G.E := { mem := λ v e, v ∈ e.val }

/-- Construct an edge from its endpoints. -/
def edge_of_adj {v w : V} (h : G.adj v w) : G.E := ⟨⟦(v,w)⟧, h⟩

lemma edge_eq_edge_of_adj (e : G.E):
  ∃ v w, ∃ (h : G.adj v w), e = G.edge_of_adj h :=
begin
  sorry
end

lemma edge_eq_edge_of_adj_iff (e : G.E) {v w} (h : G.adj v w) :
  e = G.edge_of_adj h ↔ v ∈ e ∧ w ∈ e :=
begin

  sorry
end

@[simp]
lemma mem_of_adj {v w : V} (h : G.adj v w) :
  v ∈ G.edge_of_adj h := sym2.mk_has_mem v w

@[simp]
lemma mem_of_adj_right {v w : V} (h : G.adj v w) :
  w ∈ G.edge_of_adj h := sym2.mk_has_mem_right v w

lemma adj_iff_exists_edge {v w : V} (hne : v ≠ w) :
G.adj v w ↔ ∃ (e : G.E), v ∈ e ∧ w ∈ e :=
begin
  split, { intro, use ⟦(v,w)⟧, assumption, refine ⟨(G.mem_of_adj _), (G.mem_of_adj_right _)⟩ },
  rintro ⟨e, ⟨w', hve⟩, ⟨v', hew⟩⟩,
  have : e.val = ⟦(v,w)⟧, { rw [hve, sym2.eq_iff] at hew ⊢, cc },
  have key := e.property, rwa this at key,
end

lemma empty_edge (e : (@empty V).E) : false := by tidy

lemma edge_eq_iff (e d : G.E) : e = d ↔ ∃ u, ∃ v ≠ u, u ∈ e ∧ u ∈ d ∧ v ∈ e ∧ v ∈ d :=
begin
 split,
 { rintro rfl, rcases G.edge_eq_edge_of_adj e with ⟨u, v, h, rfl⟩,
  use [u, v], have := G.ne_of_edge h, simp; cc,
 },
 rintro ⟨u, v, h, _⟩,
 have : G.adj v u, rw G.adj_iff_exists_edge h, use e, tauto,
 transitivity G.edge_of_adj this,
 { rw edge_eq_edge_of_adj_iff, tauto },
 { symmetry, rw edge_eq_edge_of_adj_iff, tauto },
end

@[ext]
lemma edge_eq_iff (e d : G.E) : e = d ↔ ∀ u, u ∈ e ↔ u ∈ d :=
begin
  split, { rintro rfl, simp },
  intro h, rw edge_eq_iff,
  rcases G.edge_eq_edge_of_adj e with ⟨u, v, h_adj, rfl⟩,
  use [u, v],
  have := G.ne_of_edge h_adj, simp only [← h], simp; tauto,
end

variables {G}

/-- Given an edge and one vertex incident on it, construct the other one. -/
noncomputable def E.other (e : G.E) {v : V} (h : v ∈ e) : V :=
by { have : v ∈ e.val, apply h, exact this.other }

lemma E.other_mem (e : G.E) {v : V} (h : v ∈ e) : e.other h ∈ e :=
begin
  change sym2.mem.other h ∈ e.val, have := sym2.mem_other_spec h,
  convert sym2.mk_has_mem_right _ _; tauto,
end

lemma E.other_ne (e : G.E) {v : V} (h : v ∈ e) : e.other h ≠ v :=
begin
  have key := e.property,
  erw [← sym2.mem_other_spec h, sym2.eq_swap] at key,
  exact G.ne_of_edge key,
end

lemma E.mem_iff (e : G.E) {v : V} (h : v ∈ e) (u : V) :
  u ∈ e ↔ u = v ∨ u = e.other h :=
begin
  convert sym2.mem_iff using 1,
  erw sym2.mem_other_spec h, refl,
end

lemma E.eq_other_iff (e : G.E) {v : V} (h : v ∈ e) (u : V) :
 u = e.other h ↔ u ≠ v ∧ u ∈ e :=
begin
  split, { rintro rfl, refine ⟨ E.other_ne _ _, E.other_mem _ _⟩ },
  rintro ⟨huv, hu⟩,
  rw e.mem_iff h at hu, tauto,
end
attribute [irreducible] E.other

instance E.inhabited [inhabited {p : V × V | G.adj p.1 p.2}] : inhabited G.E :=
⟨begin
  rcases inhabited.default {p : V × V | G.adj p.1 p.2} with ⟨⟨x, y⟩, h⟩,
  use ⟦(x, y)⟧, rwa sym2.from_rel_prop,
end⟩
#check sym2

instance edges_fintype [decidable_eq V] [fintype V] [decidable_rel G.adj] :
  fintype G.E := subtype.fintype _

section classical
open_locale classical
noncomputable theory

def E.some (e : G.E) : V :=
begin
  suffices : ∃ v, v ∈ e,
  exact classical.some this,
  sorry
end

lemma E.some_spec (e : G.E) : e.some ∈ e :=
begin
  dsimp [E.some],
  -- refine classical.some_spec _,
end

variables [fintype V]

def E_finset  (G : simple_graph V) : finset $ V × V :=
finset.filter (λ x, G.adj x.1 x.2) univ

lemma E_finset_spec [decidable_eq V] [fintype V] [decidable_rel G.adj] :
2 * fintype.card G.E = finset.card G.E_finset :=
begin
  -- transitivity 2 * finset.card _, ring,
  have : fintype.card (fin 2) = 2, { tidy },
  rw [← this, ← fintype.card_prod],
  rw ← fintype.card_of_finset, swap, { intro, refl },
  convert fintype.of_equiv_card _,
  symmetry, refine equiv.of_bijective _ _,
  rintro ⟨b, e⟩,
  refine if b = 0
    then ⟨(e.some, e.other e.some_spec), _⟩
    else ⟨(e.other e.some_spec, e.some), _⟩,
  { suffices : G.adj e.some (e.other e.some_spec), simpa [E_finset],
    rw adj_iff_exists_edge, refine ⟨ e, e.some_spec, _⟩, apply e.other_mem,
    symmetry, apply e.other_ne },
  { suffices : G.adj (e.other e.some_spec) _, simpa [E_finset],
    rw adj_iff_exists_edge, { refine ⟨ e, _, e.some_spec⟩, apply e.other_mem },
    simp [e.other_ne] },
  sorry,
  -- refine ⟨_, _⟩,
  -- intros x y h,
  -- by_cases hxy : x.1 = y.1,
  -- ext, any_goals { simp [hxy] },
  -- dsimp at h, by_cases hy : y.1 = 0,
end
variables (G)
#check prod.eq_iff_fst_eq_snd_eq
def card_edges : ℕ := fintype.card G.E

@[simp] lemma empty_card_edges : (@empty V).card_edges = 0 :=
by { dsimp [card_edges], rw fintype.card_eq_zero_iff, tidy }

@[simp] lemma card_edges_eq_zero_iff :
  G.card_edges = 0 ↔ G = empty :=
begin
  split, swap, { rintro rfl, simp },
  intro h, dsimp [card_edges] at h,
  ext, simp only [empty, iff_false], contrapose! h,
  rw [← nat.pos_iff_ne_zero, fintype.card_pos_iff],
  apply nonempty.intro, exact G.edge_of_adj h,
end

lemma empty_iff_not_edge : G = empty ↔ G.E → false :=
begin
  split, { rintro rfl, apply empty_edge },
  intro h, ext u v, suffices : ¬ G.adj u v, { tidy },
  intro he, have e := G.edge_of_adj he, exact h e,
end

def inhabited_of_ne_empty (h : G ≠ empty) : inhabited G.E :=
begin
  suffices : nonempty G.E, { letI := this, inhabit G.E, assumption },
  refine fintype.card_pos_iff.mp _, contrapose! h,
  erw [le_zero_iff_eq, card_edges_eq_zero_iff] at h, exact h,
end
end classical

attribute [irreducible] E

@[simp] lemma irrefl {v : V} : ¬G.adj v v := G.loopless v

@[symm] lemma edge_symm (u v : V) : G.adj u v ↔ G.adj v u :=
by split; apply G.sym

@[simp] lemma mem_neighbor_set (v w : V) : w ∈ G.neighbor_set v ↔ G.adj v w :=
by tauto

section finite_at

/-!
## Finiteness at a vertex

This section contains definitions and lemmas concerning vertices that
have finitely many adjacent vertices.  We denote this condition by
`fintype (G.neighbor_set v)`.

We define `G.neighbor_finset v` to be the `finset` version of `G.neighbor_set v`.
Use `neighbor_finset_eq_filter` to rewrite this definition as a `filter`.
-/

variables (v : V) [fintype (G.neighbor_set v)]
variables (G)
/--
`G.neighbors v` is the `finset` version of `G.adj v` in case `G` is
locally finite at `v`.
-/
def neighbor_finset : finset V := (G.neighbor_set v).to_finset

@[simp] lemma mem_neighbor_finset (w : V) :
  w ∈ G.neighbor_finset v ↔ G.adj v w :=
by simp [neighbor_finset]

/--
`G.degree v` is the number of vertices adjacent to `v`.
-/
def degree : ℕ := (G.neighbor_finset v).card

@[simp]
lemma card_neighbor_set_eq_degree : fintype.card (G.neighbor_set v) = G.degree v :=
by simp [degree, neighbor_finset]

end finite_at

section locally_finite

variables (G) [∀ (v : V), fintype (G.neighbor_set v)]
/--
A regular graph is a locally finite graph such that every vertex has the same degree.
-/
def regular_graph (d : ℕ) : Prop := ∀ (v : V), G.degree v = d

end locally_finite

section finite

variables [fintype V]

instance neighbor_set_fintype [decidable_rel G.adj] (v : V) : fintype (G.neighbor_set v) :=
  @subtype.fintype _ _ (by {simp_rw mem_neighbor_set, apply_instance}) _

lemma neighbor_finset_eq_filter {v : V} [decidable_rel G.adj] :
  G.neighbor_finset v = finset.univ.filter (G.adj v) :=
by { ext, simp }

@[simp]
lemma complete_graph_degree [decidable_eq V] (v : V) :
  (@complete_graph V).degree v = fintype.card V - 1 :=
begin
  convert univ.card.pred_eq_sub_one,
  erw [degree, neighbor_finset_eq_filter, filter_ne, card_erase_of_mem (mem_univ v)],
end

lemma complete_graph_is_regular [decidable_eq V] :
  (@complete_graph V).regular_graph (fintype.card V - 1) :=
by { intro v, simp }

end finite

end simple_graph
#lint-


/-
Copyright (c) 2021 Floris van Doorn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Floris van Doorn
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.measure_theory.prod
import Mathlib.measure_theory.group
import Mathlib.PostPort

universes u_1

namespace Mathlib

/-!
# Measure theory in the product of groups

In this file we show properties about measure theory in products of topological groups
and properties of iterated integrals in topological groups.

These lemmas show the uniqueness of left invariant measures on locally compact groups, up to
scaling. In this file we follow the proof and refer to the book *Measure Theory* by Paul Halmos.

The idea of the proof is to use the translation invariance of measures to prove `μ(F) = c * μ(E)`
for two sets `E` and `F`, where `c` is a constant that does not depend on `μ`. Let `e` and `f` be
the characteristic functions of `E` and `F`.
Assume that `μ` and `ν` are left-invariant measures. Then the map `(x, y) ↦ (y * x, x⁻¹)`
preserves the measure `μ.prod ν`, which means that
```
  ∫ x, ∫ y, h x y ∂ν ∂μ = ∫ x, ∫ y, h (y * x) x⁻¹ ∂ν ∂μ
```
If we apply this to `h x y := e x * f y⁻¹ / ν ((λ h, h * y⁻¹) ⁻¹' E)`, we can rewrite the RHS to
`μ(F)`, and the LHS to `c * μ(E)`, where `c = c(ν)` does not depend on `μ`.
Applying this to `μ` and to `ν` gives `μ (F) / μ (E) = ν (F) / ν (E)`, which is the uniqueness up to
scalar multiplication.

The proof in [Halmos] seems to contain an omission in §60 Th. A, see
`measure_theory.measure_lintegral_div_measure` and
https://math.stackexchange.com/questions/3974485/does-right-translation-preserve-finiteness-for-a-left-invariant-measure
-/

namespace measure_theory

/-- This condition is part of the definition of a measurable group in [Halmos, §59].
  There, the map in this lemma is called `S`. -/
theorem map_prod_mul_eq {G : Type u_1} [topological_space G] [measurable_space G]
    [topological_space.second_countable_topology G] [borel_space G] [group G] [topological_group G]
    {μ : measure G} {ν : measure G} [sigma_finite ν] [sigma_finite μ]
    (hν : is_mul_left_invariant ⇑ν) :
    coe_fn (measure.map fun (z : G × G) => (prod.fst z, prod.fst z * prod.snd z))
          (measure.prod μ ν) =
        measure.prod μ ν :=
  sorry

/-- The function we are mapping along is `SR` in [Halmos, §59],
  where `S` is the map in `map_prod_mul_eq` and `R` is `prod.swap`. -/
theorem map_prod_mul_eq_swap {G : Type u_1} [topological_space G] [measurable_space G]
    [topological_space.second_countable_topology G] [borel_space G] [group G] [topological_group G]
    {μ : measure G} {ν : measure G} [sigma_finite ν] [sigma_finite μ]
    (hμ : is_mul_left_invariant ⇑μ) :
    coe_fn (measure.map fun (z : G × G) => (prod.snd z, prod.snd z * prod.fst z))
          (measure.prod μ ν) =
        measure.prod ν μ :=
  sorry

/-- The function we are mapping along is `S⁻¹` in [Halmos, §59],
  where `S` is the map in `map_prod_mul_eq`. -/
theorem map_prod_inv_mul_eq {G : Type u_1} [topological_space G] [measurable_space G]
    [topological_space.second_countable_topology G] [borel_space G] [group G] [topological_group G]
    {μ : measure G} {ν : measure G} [sigma_finite ν] [sigma_finite μ]
    (hν : is_mul_left_invariant ⇑ν) :
    coe_fn (measure.map fun (z : G × G) => (prod.fst z, prod.fst z⁻¹ * prod.snd z))
          (measure.prod μ ν) =
        measure.prod μ ν :=
  iff.mp
    (measurable_equiv.map_apply_eq_iff_map_symm_apply_eq
      (homeomorph.to_measurable_equiv (homeomorph.shear_mul_right G)))
    (map_prod_mul_eq hν)

/-- The function we are mapping along is `S⁻¹R` in [Halmos, §59],
  where `S` is the map in `map_prod_mul_eq` and `R` is `prod.swap`. -/
theorem map_prod_inv_mul_eq_swap {G : Type u_1} [topological_space G] [measurable_space G]
    [topological_space.second_countable_topology G] [borel_space G] [group G] [topological_group G]
    {μ : measure G} {ν : measure G} [sigma_finite ν] [sigma_finite μ]
    (hμ : is_mul_left_invariant ⇑μ) :
    coe_fn (measure.map fun (z : G × G) => (prod.snd z, prod.snd z⁻¹ * prod.fst z))
          (measure.prod μ ν) =
        measure.prod ν μ :=
  sorry

/-- The function we are mapping along is `S⁻¹RSR` in [Halmos, §59],
  where `S` is the map in `map_prod_mul_eq` and `R` is `prod.swap`. -/
theorem map_prod_mul_inv_eq {G : Type u_1} [topological_space G] [measurable_space G]
    [topological_space.second_countable_topology G] [borel_space G] [group G] [topological_group G]
    {μ : measure G} {ν : measure G} [sigma_finite ν] [sigma_finite μ]
    (hμ : is_mul_left_invariant ⇑μ) (hν : is_mul_left_invariant ⇑ν) :
    coe_fn (measure.map fun (z : G × G) => (prod.snd z * prod.fst z, prod.fst z⁻¹))
          (measure.prod μ ν) =
        measure.prod μ ν :=
  sorry

theorem measure_null_of_measure_inv_null {G : Type u_1} [topological_space G] [measurable_space G]
    [topological_space.second_countable_topology G] [borel_space G] [group G] [topological_group G]
    {μ : measure G} [sigma_finite μ] (hμ : is_mul_left_invariant ⇑μ) {E : set G}
    (hE : is_measurable E) (h2E : coe_fn μ ((fun (x : G) => x⁻¹) ⁻¹' E) = 0) : coe_fn μ E = 0 :=
  sorry

theorem measure_inv_null {G : Type u_1} [topological_space G] [measurable_space G]
    [topological_space.second_countable_topology G] [borel_space G] [group G] [topological_group G]
    {μ : measure G} [sigma_finite μ] (hμ : is_mul_left_invariant ⇑μ) {E : set G}
    (hE : is_measurable E) : coe_fn μ ((fun (x : G) => x⁻¹) ⁻¹' E) = 0 ↔ coe_fn μ E = 0 :=
  sorry

theorem measurable_measure_mul_right {G : Type u_1} [topological_space G] [measurable_space G]
    [topological_space.second_countable_topology G] [borel_space G] [group G] [topological_group G]
    {μ : measure G} [sigma_finite μ] {E : set G} (hE : is_measurable E) :
    measurable fun (x : G) => coe_fn μ ((fun (y : G) => y * x) ⁻¹' E) :=
  sorry

theorem lintegral_lintegral_mul_inv {G : Type u_1} [topological_space G] [measurable_space G]
    [topological_space.second_countable_topology G] [borel_space G] [group G] [topological_group G]
    {μ : measure G} {ν : measure G} [sigma_finite ν] [sigma_finite μ]
    (hμ : is_mul_left_invariant ⇑μ) (hν : is_mul_left_invariant ⇑ν) (f : G → G → ennreal)
    (hf : measurable (function.uncurry f)) :
    (lintegral μ fun (x : G) => lintegral ν fun (y : G) => f (y * x) (x⁻¹)) =
        lintegral μ fun (x : G) => lintegral ν fun (y : G) => f x y :=
  sorry

theorem measure_mul_right_null {G : Type u_1} [topological_space G] [measurable_space G]
    [topological_space.second_countable_topology G] [borel_space G] [group G] [topological_group G]
    {μ : measure G} [sigma_finite μ] (hμ : is_mul_left_invariant ⇑μ) {E : set G}
    (hE : is_measurable E) (y : G) : coe_fn μ ((fun (x : G) => x * y) ⁻¹' E) = 0 ↔ coe_fn μ E = 0 :=
  sorry

theorem measure_mul_right_ne_zero {G : Type u_1} [topological_space G] [measurable_space G]
    [topological_space.second_countable_topology G] [borel_space G] [group G] [topological_group G]
    {μ : measure G} [sigma_finite μ] (hμ : is_mul_left_invariant ⇑μ) {E : set G}
    (hE : is_measurable E) (h2E : coe_fn μ E ≠ 0) (y : G) :
    coe_fn μ ((fun (x : G) => x * y) ⁻¹' E) ≠ 0 :=
  iff.mpr (not_iff_not_of_iff (measure_mul_right_null hμ hE y)) h2E

/-- A technical lemma relating two different measures. This is basically [Halmos, §60 Th. A].
  Note that if `f` is the characteristic function of a measurable set `F` this states that
  `μ F = c * μ E` for a constant `c` that does not depend on `μ`.
  There seems to be a gap in the last step of the proof in [Halmos].
  In the last line, the equality `g(x⁻¹)ν(Ex⁻¹) = f(x)` holds if we can prove that
  `0 < ν(Ex⁻¹) < ∞`. The first inequality follows from §59, Th. D, but I couldn't find the second
  inequality. For this reason, we use a compact `E` instead of a measurable `E` as in [Halmos], and
  additionally assume that `ν` is a regular measure (we only need that it is finite on compact
  sets). -/
theorem measure_lintegral_div_measure {G : Type u_1} [topological_space G] [measurable_space G]
    [topological_space.second_countable_topology G] [borel_space G] [group G] [topological_group G]
    {μ : measure G} {ν : measure G} [sigma_finite ν] [sigma_finite μ] [t2_space G]
    (hμ : is_mul_left_invariant ⇑μ) (hν : is_mul_left_invariant ⇑ν) (h2ν : measure.regular ν)
    {E : set G} (hE : is_compact E) (h2E : coe_fn ν E ≠ 0) (f : G → ennreal) (hf : measurable f) :
    (coe_fn μ E *
          lintegral ν fun (y : G) => f (y⁻¹) / coe_fn ν ((fun (h : G) => h * (y⁻¹)) ⁻¹' E)) =
        lintegral μ fun (x : G) => f x :=
  sorry

/-- This is roughly the uniqueness (up to a scalar) of left invariant Borel measures on a second
  countable locally compact group. The uniqueness of Haar measure is proven from this in
  `measure_theory.measure.haar_measure_unique` -/
theorem measure_mul_measure_eq {G : Type u_1} [topological_space G] [measurable_space G]
    [topological_space.second_countable_topology G] [borel_space G] [group G] [topological_group G]
    {μ : measure G} {ν : measure G} [sigma_finite ν] [sigma_finite μ] [t2_space G]
    (hμ : is_mul_left_invariant ⇑μ) (hν : is_mul_left_invariant ⇑ν) (h2ν : measure.regular ν)
    {E : set G} {F : set G} (hE : is_compact E) (hF : is_measurable F) (h2E : coe_fn ν E ≠ 0) :
    coe_fn μ E * coe_fn ν F = coe_fn ν E * coe_fn μ F :=
  sorry

end Mathlib


/-
Copyright © 2018 François G. Dorais. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
-/

import .basic .hom

universe u
variables {σ : Type u} {sig : σ → ℕ}
include sig

@[reducible]
definition subst (sub : ℕ → term sig) : term sig → term sig :=
eval (term_alg sig) sub

definition subst_app (sub : ℕ → term sig) (s : σ) {ts : term sig ^ (sig s)} :
subst sub (term.app s ts) = term.app s (tup.map (subst sub) ts) :=
eval_app (term_alg sig) sub s

definition subst_hom (sub : ℕ → term sig) :
hom (term_alg sig) (term_alg sig) (subst sub) := {app := subst_app sub}

lemma subst_eval {α : Type*} (a : alg sig α) {sub : ℕ → term sig} {val : ℕ → α} :
∀ (t : term sig), eval a val (subst sub t) = eval a (λ n, eval a val (sub n)) t
| (term.var n) := rfl
| (term.app s ts) :=
  let val' := λ n, eval a val (sub n) in
  have tup.map (eval a val) (tup.map (subst sub) ts) = tup.map (eval a val') ts,
  from tup.ext (λ i, subst_eval ts[i]),
  calc
  eval a val (subst sub (term.app s ts))
      = eval a val (term.app s (tup.map (subst sub) ts)) : by rw subst_app sub
  ... = a.app s (tup.map (eval a val) (tup.map (subst sub) ts)) : by rw eval_app a val
  ... = a.app s (tup.map (eval a val') ts) : by rw this
  ... = eval a val' (term.app s ts) : by rw eval_app a val'

namespace subst

@[reducible]
definition ident : ℕ → term sig := λ n, term.var n

@[reducible]
definition comp (sub₁ sub₂ : ℕ → term sig) : ℕ → term sig :=
λ n, subst sub₂ (sub₁ n)

lemma subst_ident : ∀ (t : term sig), subst ident t = t
| (term.var n) := rfl
| (term.app s ts) :=
  have tup.map (subst ident) ts = ts,
  from tup.ext (λ i, subst_ident (ts i)),
  calc
  subst ident (term.app s ts)
      = term.app s (tup.map (subst ident) ts) : subst_app ident s
  ... = term.app s ts : by rw this

lemma subst_subst (sub₁ sub₂ : ℕ → term sig)
: ∀ (t : term sig), subst sub₂ (subst sub₁ t) = subst (comp sub₁ sub₂) t
| (term.var n) := rfl
| (term.app s ts) :=
  have tup.map (subst sub₂) (tup.map (subst sub₁) ts) = tup.map (subst (comp sub₁ sub₂)) ts,
  from tup.ext (λ i, subst_subst ts[i]),
  calc
  subst sub₂ (subst sub₁ (term.app s ts))
      = subst sub₂ (term.app s (tup.map (subst sub₁) ts)) : by rw subst_app sub₁
  ... = term.app s (tup.map (subst sub₂) (tup.map (subst sub₁) ts)) : by rw subst_app sub₂
  ... = term.app s (tup.map (subst (comp sub₁ sub₂)) ts) : by rw this
  ... = subst (comp sub₁ sub₂) (term.app s ts) : by rw subst_app (comp sub₁ sub₂)

lemma comp_assoc (sub₁ sub₂ sub₃ : ℕ → term sig) :
comp (comp sub₁ sub₂) sub₃ = comp sub₁ (comp sub₂ sub₃) :=
funext (λ n, subst_subst sub₂ sub₃ (sub₁ n))

lemma comp_ident (sub : ℕ → term sig) :
comp sub ident = sub :=
funext (λ n, subst_ident (sub n))

lemma ident_comp (sub : ℕ → term sig) :
comp ident sub = sub :=
funext (λ n, rfl)

instance : monoid (ℕ → term sig) :=
{ mul := comp
, one := ident
, mul_assoc := comp_assoc
, mul_one := comp_ident
, one_mul := ident_comp
}

end subst


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

Separation properties of topological spaces.
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.topology.subset_properties
import Mathlib.PostPort

universes u l u_1 u_2 v

namespace Mathlib

/--
`separated` is a predicate on pairs of sub`set`s of a topological space.  It holds if the two
sub`set`s are contained in disjoint open sets.
-/
def separated {α : Type u} [topological_space α] : set α → set α → Prop :=
  fun (s t : set α) =>
    ∃ (U : set α), ∃ (V : set α), is_open U ∧ is_open V ∧ s ⊆ U ∧ t ⊆ V ∧ disjoint U V

namespace separated

theorem symm {α : Type u} [topological_space α] {s : set α} {t : set α} :
    separated s t → separated t s :=
  sorry

theorem comm {α : Type u} [topological_space α] (s : set α) (t : set α) :
    separated s t ↔ separated t s :=
  { mp := symm, mpr := symm }

theorem empty_right {α : Type u} [topological_space α] (a : set α) : separated a ∅ := sorry

theorem empty_left {α : Type u} [topological_space α] (a : set α) : separated ∅ a :=
  symm (empty_right a)

theorem union_left {α : Type u} [topological_space α] {a : set α} {b : set α} {c : set α} :
    separated a c → separated b c → separated (a ∪ b) c :=
  sorry

theorem union_right {α : Type u} [topological_space α] {a : set α} {b : set α} {c : set α}
    (ab : separated a b) (ac : separated a c) : separated a (b ∪ c) :=
  symm (union_left (symm ab) (symm ac))

end separated

/-- A T₀ space, also known as a Kolmogorov space, is a topological space
  where for every pair `x ≠ y`, there is an open set containing one but not the other. -/
class t0_space (α : Type u) [topological_space α] where
  t0 : ∀ (x y : α), x ≠ y → ∃ (U : set α), is_open U ∧ xor (x ∈ U) (y ∈ U)

theorem exists_open_singleton_of_open_finset {α : Type u} [topological_space α] [t0_space α]
    (s : finset α) (sne : finset.nonempty s) (hso : is_open ↑s) :
    ∃ (x : α), ∃ (H : x ∈ s), is_open (singleton x) :=
  sorry

theorem exists_open_singleton_of_fintype {α : Type u} [topological_space α] [t0_space α]
    [f : fintype α] [ha : Nonempty α] : ∃ (x : α), is_open (singleton x) :=
  sorry

protected instance subtype.t0_space {α : Type u} [topological_space α] [t0_space α] {p : α → Prop} :
    t0_space (Subtype p) :=
  t0_space.mk fun (x y : Subtype p) (hxy : x ≠ y) => sorry

/-- A T₁ space, also known as a Fréchet space, is a topological space
  where every singleton set is closed. Equivalently, for every pair
  `x ≠ y`, there is an open set containing `x` and not `y`. -/
class t1_space (α : Type u) [topological_space α] where
  t1 : ∀ (x : α), is_closed (singleton x)

theorem is_closed_singleton {α : Type u} [topological_space α] [t1_space α] {x : α} :
    is_closed (singleton x) :=
  t1_space.t1 x

theorem is_open_compl_singleton {α : Type u} [topological_space α] [t1_space α] {x : α} :
    is_open (singleton xᶜ) :=
  is_closed_singleton

theorem is_open_ne {α : Type u} [topological_space α] [t1_space α] {x : α} :
    is_open (set_of fun (y : α) => y ≠ x) :=
  is_open_compl_singleton

protected instance subtype.t1_space {α : Type u} [topological_space α] [t1_space α] {p : α → Prop} :
    t1_space (Subtype p) :=
  t1_space.mk fun (_x : Subtype p) => sorry

protected instance t1_space.t0_space {α : Type u} [topological_space α] [t1_space α] : t0_space α :=
  t0_space.mk
    fun (x y : α) (h : x ≠ y) =>
      Exists.intro (set_of fun (z : α) => z ≠ y)
        { left := is_open_ne, right := Or.inl { left := h, right := not_not_intro rfl } }

theorem compl_singleton_mem_nhds {α : Type u} [topological_space α] [t1_space α] {x : α} {y : α}
    (h : y ≠ x) : singleton xᶜ ∈ nhds y :=
  mem_nhds_sets is_closed_singleton
    (eq.mpr (id (Eq._oldrec (Eq.refl (y ∈ (singleton xᶜ))) (set.mem_compl_eq (singleton x) y)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (¬y ∈ singleton x)) (propext set.mem_singleton_iff))) h))

@[simp] theorem closure_singleton {α : Type u} [topological_space α] [t1_space α] {a : α} :
    closure (singleton a) = singleton a :=
  is_closed.closure_eq is_closed_singleton

theorem is_closed_map_const {α : Type u_1} {β : Type u_2} [topological_space α]
    [topological_space β] [t1_space β] {y : β} : is_closed_map (function.const α y) :=
  sorry

theorem discrete_of_t1_of_finite {X : Type u_1} [topological_space X] [t1_space X] [fintype X] :
    discrete_topology X :=
  sorry

theorem singleton_mem_nhds_within_of_mem_discrete {α : Type u} [topological_space α] {s : set α}
    [discrete_topology ↥s] {x : α} (hx : x ∈ s) : singleton x ∈ nhds_within x s :=
  sorry

theorem nhds_within_of_mem_discrete {α : Type u} [topological_space α] {s : set α}
    [discrete_topology ↥s] {x : α} (hx : x ∈ s) : nhds_within x s = pure x :=
  le_antisymm (iff.mpr filter.le_pure_iff (singleton_mem_nhds_within_of_mem_discrete hx))
    (pure_le_nhds_within hx)

theorem filter.has_basis.exists_inter_eq_singleton_of_mem_discrete {α : Type u}
    [topological_space α] {ι : Type u_1} {p : ι → Prop} {t : ι → set α} {s : set α}
    [discrete_topology ↥s] {x : α} (hb : filter.has_basis (nhds x) p t) (hx : x ∈ s) :
    ∃ (i : ι), ∃ (hi : p i), t i ∩ s = singleton x :=
  sorry

/-- A point `x` in a discrete subset `s` of a topological space admits a neighbourhood
that only meets `s` at `x`.  -/
theorem nhds_inter_eq_singleton_of_mem_discrete {α : Type u} [topological_space α] {s : set α}
    [discrete_topology ↥s] {x : α} (hx : x ∈ s) :
    ∃ (U : set α), ∃ (H : U ∈ nhds x), U ∩ s = singleton x :=
  sorry

/-- For point `x` in a discrete subset `s` of a topological space, there is a set `U`
such that
1. `U` is a punctured neighborhood of `x` (ie. `U ∪ {x}` is a neighbourhood of `x`),
2. `U` is disjoint from `s`.
-/
theorem disjoint_nhds_within_of_mem_discrete {α : Type u} [topological_space α] {s : set α}
    [discrete_topology ↥s] {x : α} (hx : x ∈ s) :
    ∃ (U : set α), ∃ (H : U ∈ nhds_within x (singleton xᶜ)), disjoint U s :=
  sorry

/-- A T₂ space, also known as a Hausdorff space, is one in which for every
  `x ≠ y` there exists disjoint open sets around `x` and `y`. This is
  the most widely used of the separation axioms. -/
class t2_space (α : Type u) [topological_space α] where
  t2 :
    ∀ (x y : α),
      x ≠ y → ∃ (u : set α), ∃ (v : set α), is_open u ∧ is_open v ∧ x ∈ u ∧ y ∈ v ∧ u ∩ v = ∅

theorem t2_separation {α : Type u} [topological_space α] [t2_space α] {x : α} {y : α} (h : x ≠ y) :
    ∃ (u : set α), ∃ (v : set α), is_open u ∧ is_open v ∧ x ∈ u ∧ y ∈ v ∧ u ∩ v = ∅ :=
  t2_space.t2 x y h

protected instance t2_space.t1_space {α : Type u} [topological_space α] [t2_space α] : t1_space α :=
  t1_space.mk
    fun (x : α) =>
      iff.mpr is_open_iff_forall_mem_open fun (y : α) (hxy : y ∈ (singleton xᶜ)) => sorry

theorem eq_of_nhds_ne_bot {α : Type u} [topological_space α] [ht : t2_space α] {x : α} {y : α}
    (h : filter.ne_bot (nhds x ⊓ nhds y)) : x = y :=
  sorry

theorem t2_iff_nhds {α : Type u} [topological_space α] :
    t2_space α ↔ ∀ {x y : α}, filter.ne_bot (nhds x ⊓ nhds y) → x = y :=
  sorry

theorem t2_iff_ultrafilter {α : Type u} [topological_space α] :
    t2_space α ↔ ∀ {x y : α} (f : ultrafilter α), ↑f ≤ nhds x → ↑f ≤ nhds y → x = y :=
  sorry

theorem is_closed_diagonal {α : Type u} [topological_space α] [t2_space α] :
    is_closed (set.diagonal α) :=
  sorry

theorem t2_iff_is_closed_diagonal {α : Type u} [topological_space α] :
    t2_space α ↔ is_closed (set.diagonal α) :=
  sorry

theorem finset_disjoint_finset_opens_of_t2 {α : Type u} [topological_space α] [t2_space α]
    (s : finset α) (t : finset α) : disjoint s t → separated ↑s ↑t :=
  sorry

theorem point_disjoint_finset_opens_of_t2 {α : Type u} [topological_space α] [t2_space α] {x : α}
    {s : finset α} (h : ¬x ∈ s) : separated (singleton x) ↑s :=
  sorry

@[simp] theorem nhds_eq_nhds_iff {α : Type u} [topological_space α] {a : α} {b : α} [t2_space α] :
    nhds a = nhds b ↔ a = b :=
  sorry

@[simp] theorem nhds_le_nhds_iff {α : Type u} [topological_space α] {a : α} {b : α} [t2_space α] :
    nhds a ≤ nhds b ↔ a = b :=
  sorry

theorem tendsto_nhds_unique {α : Type u} {β : Type v} [topological_space α] [t2_space α] {f : β → α}
    {l : filter β} {a : α} {b : α} [filter.ne_bot l] (ha : filter.tendsto f l (nhds a))
    (hb : filter.tendsto f l (nhds b)) : a = b :=
  eq_of_nhds_ne_bot (filter.ne_bot_of_le (le_inf ha hb))

theorem tendsto_nhds_unique' {α : Type u} {β : Type v} [topological_space α] [t2_space α]
    {f : β → α} {l : filter β} {a : α} {b : α} (hl : filter.ne_bot l)
    (ha : filter.tendsto f l (nhds a)) (hb : filter.tendsto f l (nhds b)) : a = b :=
  eq_of_nhds_ne_bot (filter.ne_bot_of_le (le_inf ha hb))

/-!
### Properties of `Lim` and `lim`

In this section we use explicit `nonempty α` instances for `Lim` and `lim`. This way the lemmas
are useful without a `nonempty α` instance.
-/

theorem Lim_eq {α : Type u} [topological_space α] [t2_space α] {f : filter α} {a : α}
    [filter.ne_bot f] (h : f ≤ nhds a) : Lim f = a :=
  tendsto_nhds_unique (le_nhds_Lim (Exists.intro a h)) h

theorem Lim_eq_iff {α : Type u} [topological_space α] [t2_space α] {f : filter α} [filter.ne_bot f]
    (h : ∃ (a : α), f ≤ nhds a) {a : α} : Lim f = a ↔ f ≤ nhds a :=
  { mp := fun (c : Lim f = a) => c ▸ le_nhds_Lim h, mpr := Lim_eq }

theorem ultrafilter.Lim_eq_iff_le_nhds {α : Type u} [topological_space α] [t2_space α]
    [compact_space α] {x : α} {F : ultrafilter α} : ultrafilter.Lim F = x ↔ ↑F ≤ nhds x :=
  { mp := fun (h : ultrafilter.Lim F = x) => h ▸ ultrafilter.le_nhds_Lim F, mpr := Lim_eq }

theorem is_open_iff_ultrafilter' {α : Type u} [topological_space α] [t2_space α] [compact_space α]
    (U : set α) :
    is_open U ↔ ∀ (F : ultrafilter α), ultrafilter.Lim F ∈ U → U ∈ ultrafilter.to_filter F :=
  sorry

theorem filter.tendsto.lim_eq {α : Type u} {β : Type v} [topological_space α] [t2_space α] {a : α}
    {f : filter β} [filter.ne_bot f] {g : β → α} (h : filter.tendsto g f (nhds a)) : lim f g = a :=
  Lim_eq h

theorem filter.lim_eq_iff {α : Type u} {β : Type v} [topological_space α] [t2_space α]
    {f : filter β} [filter.ne_bot f] {g : β → α} (h : ∃ (a : α), filter.tendsto g f (nhds a))
    {a : α} : lim f g = a ↔ filter.tendsto g f (nhds a) :=
  { mp := fun (c : lim f g = a) => c ▸ tendsto_nhds_lim h, mpr := filter.tendsto.lim_eq }

theorem continuous.lim_eq {α : Type u} {β : Type v} [topological_space α] [t2_space α]
    [topological_space β] {f : β → α} (h : continuous f) (a : β) : lim (nhds a) f = f a :=
  filter.tendsto.lim_eq (continuous.tendsto h a)

@[simp] theorem Lim_nhds {α : Type u} [topological_space α] [t2_space α] (a : α) :
    Lim (nhds a) = a :=
  Lim_eq (le_refl (nhds a))

@[simp] theorem lim_nhds_id {α : Type u} [topological_space α] [t2_space α] (a : α) :
    lim (nhds a) id = a :=
  Lim_nhds a

@[simp] theorem Lim_nhds_within {α : Type u} [topological_space α] [t2_space α] {a : α} {s : set α}
    (h : a ∈ closure s) : Lim (nhds_within a s) = a :=
  Lim_eq inf_le_left

@[simp] theorem lim_nhds_within_id {α : Type u} [topological_space α] [t2_space α] {a : α}
    {s : set α} (h : a ∈ closure s) : lim (nhds_within a s) id = a :=
  Lim_nhds_within h

/-!
### Instances of `t2_space` typeclass

We use two lemmas to prove that various standard constructions generate Hausdorff spaces from
Hausdorff spaces:

* `separated_by_continuous` says that two points `x y : α` can be separated by open neighborhoods
  provided that there exists a continuous map `f`: α → β` with a Hausdorff codomain such that
  `f x ≠ f y`. We use this lemma to prove that topological spaces defined using `induced` are
  Hausdorff spaces.

* `separated_by_open_embedding` says that for an open embedding `f : α → β` of a Hausdorff space
  `α`, the images of two distinct points `x y : α`, `x ≠ y` can be separated by open neighborhoods.
  We use this lemma to prove that topological spaces defined using `coinduced` are Hausdorff spaces.
-/

protected instance t2_space_discrete {α : Type u_1} [topological_space α] [discrete_topology α] :
    t2_space α :=
  sorry

theorem separated_by_continuous {α : Type u_1} {β : Type u_2} [topological_space α]
    [topological_space β] [t2_space β] {f : α → β} (hf : continuous f) {x : α} {y : α}
    (h : f x ≠ f y) :
    ∃ (u : set α), ∃ (v : set α), is_open u ∧ is_open v ∧ x ∈ u ∧ y ∈ v ∧ u ∩ v = ∅ :=
  sorry

theorem separated_by_open_embedding {α : Type u_1} {β : Type u_2} [topological_space α]
    [topological_space β] [t2_space α] {f : α → β} (hf : open_embedding f) {x : α} {y : α}
    (h : x ≠ y) :
    ∃ (u : set β), ∃ (v : set β), is_open u ∧ is_open v ∧ f x ∈ u ∧ f y ∈ v ∧ u ∩ v = ∅ :=
  sorry

protected instance subtype.t2_space {α : Type u_1} {p : α → Prop} [t : topological_space α]
    [t2_space α] : t2_space (Subtype p) :=
  t2_space.mk
    fun (x y : Subtype p) (h : x ≠ y) =>
      separated_by_continuous continuous_subtype_val (mt subtype.eq h)

protected instance prod.t2_space {α : Type u_1} {β : Type u_2} [t₁ : topological_space α]
    [t2_space α] [t₂ : topological_space β] [t2_space β] : t2_space (α × β) :=
  t2_space.mk fun (_x : α × β) => sorry

protected instance sum.t2_space {α : Type u_1} {β : Type u_2} [t₁ : topological_space α]
    [t2_space α] [t₂ : topological_space β] [t2_space β] : t2_space (α ⊕ β) :=
  sorry

protected instance Pi.t2_space {α : Type u_1} {β : α → Type v}
    [t₂ : (a : α) → topological_space (β a)] [∀ (a : α), t2_space (β a)] :
    t2_space ((a : α) → β a) :=
  t2_space.mk fun (x y : (a : α) → β a) (h : x ≠ y) => sorry

protected instance sigma.t2_space {ι : Type u_1} {α : ι → Type u_2}
    [(i : ι) → topological_space (α i)] [∀ (a : ι), t2_space (α a)] :
    t2_space (sigma fun (i : ι) => α i) :=
  sorry

theorem is_closed_eq {α : Type u} {β : Type v} [topological_space α] [topological_space β]
    [t2_space α] {f : β → α} {g : β → α} (hf : continuous f) (hg : continuous g) :
    is_closed (set_of fun (x : β) => f x = g x) :=
  iff.mp continuous_iff_is_closed (continuous.prod_mk hf hg) (set.diagonal α) is_closed_diagonal

/-- If two continuous maps are equal on `s`, then they are equal on the closure of `s`. -/
theorem set.eq_on.closure {α : Type u} {β : Type v} [topological_space α] [topological_space β]
    [t2_space α] {s : set β} {f : β → α} {g : β → α} (h : set.eq_on f g s) (hf : continuous f)
    (hg : continuous g) : set.eq_on f g (closure s) :=
  closure_minimal h (is_closed_eq hf hg)

/-- If two continuous functions are equal on a dense set, then they are equal. -/
theorem continuous.ext_on {α : Type u} {β : Type v} [topological_space α] [topological_space β]
    [t2_space α] {s : set β} (hs : dense s) {f : β → α} {g : β → α} (hf : continuous f)
    (hg : continuous g) (h : set.eq_on f g s) : f = g :=
  funext fun (x : β) => set.eq_on.closure h hf hg (hs x)

theorem diagonal_eq_range_diagonal_map {α : Type u_1} :
    (set_of fun (p : α × α) => prod.fst p = prod.snd p) = set.range fun (x : α) => (x, x) :=
  sorry

theorem prod_subset_compl_diagonal_iff_disjoint {α : Type u_1} {s : set α} {t : set α} :
    set.prod s t ⊆ ((set_of fun (p : α × α) => prod.fst p = prod.snd p)ᶜ) ↔ s ∩ t = ∅ :=
  sorry

theorem compact_compact_separated {α : Type u} [topological_space α] [t2_space α] {s : set α}
    {t : set α} (hs : is_compact s) (ht : is_compact t) (hst : s ∩ t = ∅) :
    ∃ (u : set α), ∃ (v : set α), is_open u ∧ is_open v ∧ s ⊆ u ∧ t ⊆ v ∧ u ∩ v = ∅ :=
  sorry

/-- In a `t2_space`, every compact set is closed. -/
theorem is_compact.is_closed {α : Type u} [topological_space α] [t2_space α] {s : set α}
    (hs : is_compact s) : is_closed s :=
  sorry

theorem is_compact.inter {α : Type u} [topological_space α] [t2_space α] {s : set α} {t : set α}
    (hs : is_compact s) (ht : is_compact t) : is_compact (s ∩ t) :=
  is_compact.inter_right hs (is_compact.is_closed ht)

/-- If a compact set is covered by two open sets, then we can cover it by two compact subsets. -/
theorem is_compact.binary_compact_cover {α : Type u} [topological_space α] [t2_space α] {K : set α}
    {U : set α} {V : set α} (hK : is_compact K) (hU : is_open U) (hV : is_open V)
    (h2K : K ⊆ U ∪ V) :
    ∃ (K₁ : set α), ∃ (K₂ : set α), is_compact K₁ ∧ is_compact K₂ ∧ K₁ ⊆ U ∧ K₂ ⊆ V ∧ K = K₁ ∪ K₂ :=
  sorry

/-- For every finite open cover `Uᵢ` of a compact set, there exists a compact cover `Kᵢ ⊆ Uᵢ`. -/
theorem is_compact.finite_compact_cover {α : Type u} [topological_space α] [t2_space α] {s : set α}
    (hs : is_compact s) {ι : Type u_1} (t : finset ι) (U : ι → set α)
    (hU : ∀ (i : ι), i ∈ t → is_open (U i))
    (hsC : s ⊆ set.Union fun (i : ι) => set.Union fun (H : i ∈ t) => U i) :
    ∃ (K : ι → set α),
        (∀ (i : ι), is_compact (K i)) ∧
          (∀ (i : ι), K i ⊆ U i) ∧ s = set.Union fun (i : ι) => set.Union fun (H : i ∈ t) => K i :=
  sorry

theorem locally_compact_of_compact_nhds {α : Type u} [topological_space α] [t2_space α]
    (h : ∀ (x : α), ∃ (s : set α), s ∈ nhds x ∧ is_compact s) : locally_compact_space α :=
  sorry

protected instance locally_compact_of_compact {α : Type u} [topological_space α] [t2_space α]
    [compact_space α] : locally_compact_space α :=
  locally_compact_of_compact_nhds
    fun (x : α) =>
      Exists.intro set.univ { left := mem_nhds_sets is_open_univ trivial, right := compact_univ }

/-- In a locally compact T₂ space, every point has an open neighborhood with compact closure -/
theorem exists_open_with_compact_closure {α : Type u} [topological_space α]
    [locally_compact_space α] [t2_space α] (x : α) :
    ∃ (U : set α), is_open U ∧ x ∈ U ∧ is_compact (closure U) :=
  sorry

/-- In a locally compact T₂ space, every compact set is contained in the interior of a compact
  set. -/
theorem exists_compact_superset {α : Type u} [topological_space α] [locally_compact_space α]
    [t2_space α] {K : set α} (hK : is_compact K) :
    ∃ (K' : set α), is_compact K' ∧ K ⊆ interior K' :=
  sorry

/-- A T₃ space, also known as a regular space (although this condition sometimes
  omits T₂), is one in which for every closed `C` and `x ∉ C`, there exist
  disjoint open sets containing `x` and `C` respectively. -/
class regular_space (α : Type u) [topological_space α] extends t1_space α where
  regular :
    ∀ {s : set α} {a : α},
      is_closed s → ¬a ∈ s → ∃ (t : set α), is_open t ∧ s ⊆ t ∧ nhds_within a t = ⊥

theorem nhds_is_closed {α : Type u} [topological_space α] [regular_space α] {a : α} {s : set α}
    (h : s ∈ nhds a) : ∃ (t : set α), ∃ (H : t ∈ nhds a), t ⊆ s ∧ is_closed t :=
  sorry

theorem closed_nhds_basis {α : Type u} [topological_space α] [regular_space α] (a : α) :
    filter.has_basis (nhds a) (fun (s : set α) => s ∈ nhds a ∧ is_closed s) id :=
  sorry

protected instance subtype.regular_space {α : Type u} [topological_space α] [regular_space α]
    {p : α → Prop} : regular_space (Subtype p) :=
  sorry

protected instance regular_space.t2_space (α : Type u) [topological_space α] [regular_space α] :
    t2_space α :=
  t2_space.mk fun (x y : α) (hxy : x ≠ y) => sorry

theorem disjoint_nested_nhds {α : Type u} [topological_space α] [regular_space α] {x : α} {y : α}
    (h : x ≠ y) :
    ∃ (U₁ : set α),
        ∃ (V₁ : set α),
          ∃ (H : U₁ ∈ nhds x),
            ∃ (H : V₁ ∈ nhds x),
              ∃ (U₂ : set α),
                ∃ (V₂ : set α),
                  ∃ (H : U₂ ∈ nhds y),
                    ∃ (H : V₂ ∈ nhds y),
                      is_closed V₁ ∧
                        is_closed V₂ ∧ is_open U₁ ∧ is_open U₂ ∧ V₁ ⊆ U₁ ∧ V₂ ⊆ U₂ ∧ U₁ ∩ U₂ = ∅ :=
  sorry

/-- A T₄ space, also known as a normal space (although this condition sometimes
  omits T₂), is one in which for every pair of disjoint closed sets `C` and `D`,
  there exist disjoint open sets containing `C` and `D` respectively. -/
class normal_space (α : Type u) [topological_space α] extends t1_space α where
  normal :
    ∀ (s t : set α),
      is_closed s →
        is_closed t →
          disjoint s t →
            ∃ (u : set α), ∃ (v : set α), is_open u ∧ is_open v ∧ s ⊆ u ∧ t ⊆ v ∧ disjoint u v

theorem normal_separation {α : Type u} [topological_space α] [normal_space α] (s : set α)
    (t : set α) (H1 : is_closed s) (H2 : is_closed t) (H3 : disjoint s t) :
    ∃ (u : set α), ∃ (v : set α), is_open u ∧ is_open v ∧ s ⊆ u ∧ t ⊆ v ∧ disjoint u v :=
  normal_space.normal s t H1 H2 H3

protected instance normal_space.regular_space {α : Type u} [topological_space α] [normal_space α] :
    regular_space α :=
  regular_space.mk fun (s : set α) (x : α) (hs : is_closed s) (hxs : ¬x ∈ s) => sorry

-- We can't make this an instance because it could cause an instance loop.

theorem normal_of_compact_t2 {α : Type u} [topological_space α] [compact_space α] [t2_space α] :
    normal_space α :=
  sorry

/-- In a compact t2 space, the connected component of a point equals the intersection of all
its clopen neighbourhoods. -/
theorem connected_component_eq_Inter_clopen {α : Type u} [topological_space α] [t2_space α]
    [compact_space α] {x : α} :
    connected_component x =
        set.Inter fun (Z : Subtype fun (Z : set α) => is_clopen Z ∧ x ∈ Z) => ↑Z :=
  sorry

end Mathlib


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

/-!
# The morphism comparing a colimit of limits with the corresponding limit of colimits.

For `F : J × K ⥤ C` there is always a morphism $\colim_k \lim_j F(j,k) → \lim_j \colim_k F(j, k)$.
While it is not usually an isomorphism, with additional hypotheses on `J` and `K` it may be,
in which case we say that "colimits commute with limits".

The prototypical example, proved in `category_theory.limits.filtered_colimit_commutes_finite_limit`,
is that when `C = Type`, filtered colimits commute with finite limits.

## References
* Borceux, Handbook of categorical algebra 1, Section 2.13
* [Stacks: Filtered colimits](https://stacks.math.columbia.edu/tag/002W)
-/

universes v u

open category_theory

namespace category_theory.limits

variables {J K : Type v} [small_category J] [small_category K]
variables {C : Type u} [category.{v} C]

variables (F : J × K ⥤ C)

open category_theory.prod

lemma map_id_left_eq_curry_map {j : J} {k k' : K} {f : k ⟶ k'} :
  F.map ((𝟙 j, f) : (j, k) ⟶ (j, k')) = ((curry.obj F).obj j).map f :=
rfl

lemma map_id_right_eq_curry_swap_map {j j' : J} {f : j ⟶ j'} {k : K} :
  F.map ((f, 𝟙 k) : (j, k) ⟶ (j', k)) = ((curry.obj (swap K J ⋙ F)).obj k).map f :=
rfl

variables [has_limits_of_shape J C]
variables [has_colimits_of_shape K C]

/--
The universal morphism
$\colim_k \lim_j F(j,k) → \lim_j \colim_k F(j, k)$.
-/
noncomputable
def colimit_limit_to_limit_colimit :
  colimit ((curry.obj (swap K J ⋙ F)) ⋙ lim) ⟶ limit ((curry.obj F) ⋙ colim) :=
limit.lift ((curry.obj F) ⋙ colim)
{ X := _,
  π :=
  { app := λ j, colimit.desc ((curry.obj (swap K J ⋙ F)) ⋙ lim)
    { X := _,
      ι :=
      { app := λ k,
          limit.π ((curry.obj (swap K J ⋙ F)).obj k) j ≫ colimit.ι ((curry.obj F).obj j) k,
        naturality' :=
        begin
          dsimp,
          intros k k' f,
          simp only [functor.comp_map, curry.obj_map_app, limits.lim_map_π_assoc, swap_map,
            category.comp_id, map_id_left_eq_curry_map, colimit.w],
        end }, },
    naturality' :=
    begin
      dsimp,
      intros j j' f,
      ext k,
      simp only [limits.colimit.ι_map, curry.obj_map_app, limits.colimit.ι_desc_assoc,
        limits.colimit.ι_desc, category.id_comp, category.assoc, map_id_right_eq_curry_swap_map,
        limit.w_assoc],
    end } }

/--
Since `colimit_limit_to_limit_colimit` is a morphism from a colimit to a limit,
this lemma characterises it.
-/
@[simp] lemma ι_colimit_limit_to_limit_colimit_π (j) (k) :
  colimit.ι _ k ≫ colimit_limit_to_limit_colimit F ≫ limit.π _ j =
    limit.π ((curry.obj (swap K J ⋙ F)).obj k) j ≫ colimit.ι ((curry.obj F).obj j) k :=
by { dsimp [colimit_limit_to_limit_colimit], simp, }

@[simp] lemma ι_colimit_limit_to_limit_colimit_π_apply (F : J × K ⥤ Type v) (j) (k) (f) :
   limit.π ((curry.obj F) ⋙ colim) j
     (colimit_limit_to_limit_colimit F (colimit.ι ((curry.obj (swap K J ⋙ F)) ⋙ lim) k f)) =
     colimit.ι ((curry.obj F).obj j) k (limit.π ((curry.obj (swap K J ⋙ F)).obj k) j f) :=
by { dsimp [colimit_limit_to_limit_colimit], simp, }

end category_theory.limits