class category (C : Type) :=
( hom : C → C → Type )
( id : (X : C) → hom X X )
( comp : {X Y Z : C} → hom X Y → hom Y Z → hom X Z )
( id_comp {X Y : C} (f : hom X Y) : comp (id X) f = f )
( comp_id {X Y : C} (f : hom X Y) : comp f (id Y) = f )
( assoc {W X Y Z : C} (f : hom W X) (g : hom X Y) (h : hom Y Z) :
    comp (comp f g) h = comp f (comp g h) )

notation " 𝟙 " => category.id
infixr: 80 " ≫ " => category.comp
infixr: 10 " ⟶ " => category.hom

variable (C : Type) [category C]

inductive prod_coprod : Type
| of_cat' : C → prod_coprod
| prod : prod_coprod → prod_coprod → prod_coprod
| coprod : prod_coprod → prod_coprod → prod_coprod

variable {C}

namespace prod_coprod
@[simp] def size : prod_coprod C → Nat
| of_cat' _ => 1
| prod X Y => size X + size Y + 1
| coprod X Y => size X + size Y + 1

inductive syn : (X Y : prod_coprod C) → Type
| of_cat {X Y : C} : (X ⟶ Y) → syn (of_cat' X) (of_cat' Y)
| prod_mk {X Y Z : prod_coprod C} : syn X Y → syn X Z → syn X (Y.prod Z)
| fst {X Y : prod_coprod C} : syn (X.prod Y) X
| snd {X Y : prod_coprod C} : syn (X.prod Y) Y
| coprod_mk {X Y Z : prod_coprod C} : syn X Z → syn Y Z → syn (X.coprod Y) Z
| inl {X Y : prod_coprod C} : syn X (X.coprod Y)
| inr {X Y : prod_coprod C} : syn Y (X.coprod Y)
| id (X : prod_coprod C) : syn X X
| comp {X Y Z : prod_coprod C} : syn X Y → syn Y Z → syn X Z

namespace syn

inductive rel : {X Y : prod_coprod C} → syn X Y → syn X Y → Prop
| refl {X Y : prod_coprod C} (f : syn X Y) : rel f f
| symm {X Y : prod_coprod C} {f g : syn X Y} : rel f g → rel g f
| trans {X Y : prod_coprod C} {f g h : syn X Y} : rel f g → rel g h → rel f h
| comp_congr {X Y Z : prod_coprod C} {f₁ f₂ : syn X Y} {g₁ g₂ : syn Y Z} :
  rel f₁ f₂ → rel g₁ g₂ → rel (f₁.comp g₁) (f₂.comp g₂)
| prod_mk_congr {X Y Z : prod_coprod C} {f₁ f₂ : syn X Y} {g₁ g₂ : syn X Z} :
  rel f₁ f₂ → rel g₁ g₂ → rel (f₁.prod_mk g₁) (f₂.prod_mk g₂)
| coprod_mk_congr {X Y Z : prod_coprod C} {f₁ f₂ : syn X Z} {g₁ g₂ : syn Y Z} :
  rel f₁ f₂ → rel g₁ g₂ → rel (f₁.coprod_mk g₁) (f₂.coprod_mk g₂)
| id_comp {X Y : prod_coprod C} (f : syn X Y) : rel ((syn.id X).comp f) f
| comp_id {X Y : prod_coprod C} (f : syn X Y) : rel (f.comp (syn.id Y)) f
| assoc {W X Y Z : prod_coprod C} (f : syn W X) (g : syn X Y) (h : syn Y Z) :
  rel ((f.comp g).comp h) (f.comp (g.comp h))
| of_cat_id {X : C} : rel (syn.of_cat (𝟙 X)) (syn.id (of_cat' X))
| of_cat_comp {X Y Z : C} (f : X ⟶ Y) (g : Y ⟶ Z) :
  rel (syn.of_cat (f ≫ g)) (syn.comp (syn.of_cat f) (syn.of_cat g))
| mk_fst_comp {X Y Z : prod_coprod C} (f : syn X Y) (g : syn X Z) :
  rel (syn.comp (syn.prod_mk f g) syn.fst) f
| mk_snd_comp {X Y Z : prod_coprod C} (f : syn X Y) (g : syn X Z) :
  rel (syn.comp (syn.prod_mk f g) syn.snd) g
| prod_eta {X Y Z : prod_coprod C} (f : syn X (Y.prod Z)) :
  rel (syn.prod_mk (f.comp syn.fst) (f.comp syn.snd)) f
| inl_comp_mk {X Y Z : prod_coprod C} (f : syn X Z) (g : syn Y Z) :
  rel (syn.comp syn.inl (syn.coprod_mk f g)) f
| inr_comp_mk {X Y Z : prod_coprod C} (f : syn X Z) (g : syn Y Z) :
  rel (syn.comp syn.inr (syn.coprod_mk f g)) g
| coprod_eta {X Y Z : prod_coprod C} (f : syn (X.coprod Y) Z) :
  rel (syn.coprod_mk (syn.inl.comp f) (syn.inr.comp f)) f

infixl:50 " ♥ " => rel

instance : Trans (@rel C _ X Y) (@rel C _ X Y) (@rel C _ X Y) where
  trans := rel.trans

theorem rel_prod {X Y Z : prod_coprod C} {f g : syn X (Y.prod Z)}
  (h₁ : rel (f.comp syn.fst) (g.comp syn.fst))
  (h₂ : rel (f.comp syn.snd) (g.comp syn.snd)) :
  rel f g :=
rel.trans (rel.symm (rel.prod_eta f)) (rel.trans (rel.prod_mk_congr h₁ h₂) (rel.prod_eta g))

theorem rel_coprod {X Y Z : prod_coprod C} {f g : syn (X.coprod Y) Z}
  (h₁ : rel (syn.inl.comp f) (syn.inl.comp g))
  (h₂ : rel (syn.inr.comp f) (syn.inr.comp g)) :
  rel f g :=
rel.trans (rel.symm (rel.coprod_eta f)) (rel.trans (rel.coprod_mk_congr h₁ h₂) (rel.coprod_eta g))

end syn

inductive list_proj : (X Y : prod_coprod C) → Type -- Y is not prod
| empty {X : prod_coprod C} : list_proj X X
| fst_comp {X Y Z : prod_coprod C} (f : list_proj X Z) : list_proj (prod X Y) Z
| snd_comp {X Y Z : prod_coprod C} (f : list_proj Y Z) : list_proj (prod X Y) Z

inductive list_inj : (X Y : prod_coprod C) → Type -- X is not coprod
| empty {X : prod_coprod C} : list_inj X X
| comp_inl {X Y Z : prod_coprod C} (f : list_inj X Y) : list_inj X (coprod Y Z)
| comp_inr {X Y Z : prod_coprod C} (f : list_inj X Z) : list_inj X (coprod Y Z)

inductive norm_hom : prod_coprod C → prod_coprod C → Type
| prod_mk_of_cat {W : C} {X Y Z : prod_coprod C}
  (f : norm_hom (of_cat' W) X) (g : norm_hom (of_cat' W) Y)
  (h : list_inj (prod X Y) Z) :
  norm_hom (of_cat' W) Z
| prod_mk_prod {V W X Y Z : prod_coprod C}
  (f : norm_hom (prod V W) X) (g : norm_hom (prod V W) Y)
  (h : list_inj (prod X Y) Z) :
  norm_hom (prod V W) Z
| coprod_mk_of_cat {W X Y : prod_coprod C} {Z : C}
  (f : list_proj W (coprod X Y))
  (g : norm_hom X (of_cat' Z)) (h : norm_hom Y (of_cat' Z)) :
  norm_hom W (of_cat' Z)
| coprod_mk_coprod {V W X Y Z : prod_coprod C}
  (f : list_proj V (coprod W X))
  (g : norm_hom W (coprod Y Z)) (h : norm_hom X (coprod Y Z)) :
  norm_hom V (coprod Y Z)
| prod_mk_coprod {W X Y Z : prod_coprod C}
  (f : norm_hom (coprod W X) Y) (g : norm_hom (coprod W X) Z) :
  norm_hom (coprod W X) (prod Y Z)
| of_cat {W : prod_coprod C} {X Y : C} {Z : prod_coprod C}
  (f : list_proj W (of_cat' X)) (g : X ⟶ Y)
  (h : list_inj (of_cat' Y) Z) : norm_hom W Z

namespace norm_hom

open list_inj list_proj

def prod_mk : {X Y Z : prod_coprod C} → (f : norm_hom X Y) → (g : norm_hom X Z) →
  norm_hom X (prod Y Z)
| (of_cat' _), _, _, f, g => prod_mk_of_cat f g empty
| (coprod _ _), _, _, f, g => prod_mk_coprod f g
| (prod _ _), _ ,_, f, g => prod_mk_prod f g empty

def comp_fst : {X Y Z : prod_coprod C} → (f : norm_hom X (prod Y Z)) → norm_hom X Y
| _, _, _, (prod_mk_of_cat f _ list_inj.empty) => f
| _, _, _, (prod_mk_prod f _ list_inj.empty) => f
| _, _, _, (prod_mk_coprod f _) => f

@[simp] theorem comp_fst_prod_mk {X Y Z : prod_coprod C} (f : norm_hom X Y) (g : norm_hom X Z) :
  comp_fst (prod_mk f g) = f :=
by cases X <;> simp [comp_fst, prod_mk]

def comp_snd : {X Y Z : prod_coprod C} → (f : norm_hom X (prod Y Z)) → norm_hom X Z
| _, _, _, (prod_mk_of_cat _ g list_inj.empty) => g
| _, _, _, (prod_mk_prod _ g list_inj.empty) => g
| _, _, _, (prod_mk_coprod _ g) => g

@[simp] theorem comp_snd_prod_mk {X Y Z : prod_coprod C} (f : norm_hom X Y) (g : norm_hom X Z) :
  comp_snd (prod_mk f g) = g :=
by cases X <;> simp [comp_snd, prod_mk]

theorem prod_eta : {X Y Z : prod_coprod C} → (f : norm_hom X (prod Y Z)) →
  prod_mk (comp_fst f) (comp_snd f) = f
| _, _, _, (prod_mk_of_cat _ _ list_inj.empty) => rfl
| _, _, _, (prod_mk_prod _ _ list_inj.empty) => rfl
| _, _, _, (prod_mk_coprod _ _) => rfl

theorem ext_prod {X Y Z : prod_coprod C} {f g : norm_hom X (prod Y Z)}
  (h₁ : f.comp_fst = g.comp_fst) (h₂ : f.comp_snd = g.comp_snd) :
  f = g :=
by rw [← prod_eta f, h₁, h₂, prod_eta]

def coprod_mk : {X Y Z : prod_coprod C} → (f : norm_hom X Z) → (g : norm_hom Y Z) →
  norm_hom (coprod X Y) Z
| _, _, (of_cat' _), f, g => coprod_mk_of_cat empty f g
| _, _, (coprod _ _), f, g => coprod_mk_coprod empty f g
| _, _, (prod _ _), f, g => prod_mk_coprod
  (coprod_mk (comp_fst f) (comp_fst g))
  (coprod_mk (comp_snd f) (comp_snd g))

theorem coprod_mk_comp_fst {W X Y Z : prod_coprod C}
  (f : norm_hom W (prod Y Z)) (g : norm_hom X (prod Y Z)) :
  comp_fst (coprod_mk f g) = coprod_mk (comp_fst f) (comp_fst g) :=
by
  cases Y <;>
  simp [coprod_mk, comp_fst]

theorem coprod_mk_comp_snd {W X Y Z : prod_coprod C}
  (f : norm_hom W (prod Y Z)) (g : norm_hom X (prod Y Z)) :
  comp_snd (coprod_mk f g) = coprod_mk (comp_snd f) (comp_snd g) :=
by
  intros
  cases Y <;>
  simp [coprod_mk, comp_snd]

def inl_comp : {X Y Z : prod_coprod C} → norm_hom (coprod X Y) Z → norm_hom X Z
| _, _, _, (coprod_mk_of_cat list_proj.empty g _) => g
| _, _, _, (coprod_mk_coprod list_proj.empty g _) => g
| _, _, _, prod_mk_coprod f g => prod_mk (inl_comp f) (inl_comp g)

def inr_comp : {X Y Z : prod_coprod C} → norm_hom (coprod X Y) Z → norm_hom Y Z
| _, _, _, (coprod_mk_of_cat list_proj.empty _ h) => h
| _, _, _, (coprod_mk_coprod list_proj.empty _ h) => h
| _, _, _, (prod_mk_coprod f g) => prod_mk (inr_comp f) (inr_comp g)

theorem inl_comp_comp_fst : {W X Y Z : prod_coprod C} → (f : norm_hom (coprod W X) (prod Y Z)) →
  inl_comp (comp_fst f) = comp_fst (inl_comp f)
| _, _, _, _, (prod_mk_coprod f g) => by
rw [inl_comp, comp_fst]
simp

theorem inr_comp_comp_fst : {W X Y Z : prod_coprod C} → (f : norm_hom (coprod W X) (prod Y Z)) →
  inr_comp (comp_fst f) = comp_fst (inr_comp f)
| _, _, _, _, (prod_mk_coprod f g) => by
rw [comp_fst, inr_comp]
simp

theorem inl_comp_comp_snd : {W X Y Z : prod_coprod C} → (f : norm_hom (coprod W X) (prod Y Z)) →
  inl_comp (comp_snd f) = comp_snd (inl_comp f)
| A, B, D, _, (prod_mk_coprod f g) => by
rw [comp_snd, inl_comp]
simp

theorem inr_comp_comp_snd : {W X Y Z : prod_coprod C} → (f : norm_hom (coprod W X) (prod Y Z)) →
  inr_comp (comp_snd f) = comp_snd (inr_comp f)
| _, _, _, _, (prod_mk_coprod f g) => by
rw [comp_snd, inr_comp]
simp

@[simp] theorem inl_comp_coprod_mk : {X Y Z : prod_coprod C} → (f : norm_hom X Z) → (g : norm_hom Y Z) →
  inl_comp (coprod_mk f g) = f
| _, _, (of_cat' Z), _, _ => rfl
| _, _, (coprod Y Z), _, _ => rfl
| _, _, (prod Y Z), f, g =>
by rw [coprod_mk, inl_comp, inl_comp_coprod_mk, inl_comp_coprod_mk, prod_eta]

@[simp] theorem inr_comp_coprod_mk : {X Y Z : prod_coprod C} → (f : norm_hom X Z) → (g : norm_hom Y Z) →
  inr_comp (coprod_mk f g) = g
| _, _, (of_cat' Z), _, _ => rfl
| _, _, (coprod Y Z), _, _ => rfl
| _, _, (prod Y Z), f, g =>
by rw [coprod_mk, inr_comp, inr_comp_coprod_mk, inr_comp_coprod_mk, prod_eta]

theorem coprod_eta : {X Y Z : prod_coprod C} → (f : norm_hom (coprod X Y) Z) →
  coprod_mk (inl_comp f) (inr_comp f) = f
| _, _, _, (coprod_mk_of_cat list_proj.empty g h) => rfl
| _, _, _, (coprod_mk_coprod list_proj.empty g h) => rfl
| _, _, _, (prod_mk_coprod f g) =>
  by simp [coprod_mk, inl_comp, inr_comp, coprod_eta f, coprod_eta g]

theorem ext_coprod {X Y Z : prod_coprod C} {f g : norm_hom (coprod X Y) Z}
  (h₁ : f.inl_comp = g.inl_comp) (h₂ : f.inr_comp = g.inr_comp) :
  f = g :=
by rw [← coprod_eta f, h₁, h₂, coprod_eta]

def prod_mk_l : {W X Y Z : prod_coprod C} → (f : norm_hom W X) → (g : norm_hom W Y) →
  (h : list_inj (prod X Y) Z) → norm_hom W Z
| (of_cat' _), _, _, _, f, g, h => prod_mk_of_cat f g h
| (coprod _ _), _, _, _, f, g, h =>
  coprod_mk
    (prod_mk_l (inl_comp f) (inl_comp g) h)
    (prod_mk_l (inr_comp f) (inr_comp g) h)
| (prod _ _), _, _, _, f, g, h => prod_mk_prod f g h

theorem coprod_mk_prod_mk_l {V W X Y Z : prod_coprod C}
  (f : norm_hom V X) (g : norm_hom V Y)
  (h : norm_hom W X) (i : norm_hom W Y)
  (j : list_inj (prod X Y) Z) :
  coprod_mk (prod_mk_l f g j) (prod_mk_l h i j) =
  prod_mk_l (coprod_mk f h) (coprod_mk g i) j := by
cases X <;> cases Y <;> cases Z <;>
simp [coprod_mk, prod_mk_l, inl_comp, inr_comp, prod_eta]

def coprod_mk_l : {W X Y Z : prod_coprod C} → (f : list_proj W (coprod X Y)) →
  (g : norm_hom X Z) → (h : norm_hom Y Z) → norm_hom W Z
| _, _, _, (of_cat' _), f, g, h => coprod_mk_of_cat f g h
| _, _, _, (prod _ _), f, g, h =>
  prod_mk
    (coprod_mk_l f (comp_fst g) (comp_fst h))
    (coprod_mk_l f (comp_snd g) (comp_snd h))
| _, _, _, (coprod _ _), f, g, h => coprod_mk_coprod f g h

def fst_comp : {X Y Z : prod_coprod C} →
  (f : norm_hom X Z) → norm_hom (prod X Y) Z
| _, _, _, (prod_mk_of_cat f g h) =>
  prod_mk_l (fst_comp f) (fst_comp g) h
| _, _, _, (prod_mk_prod f g h) =>
  prod_mk_l (fst_comp f) (fst_comp g) h
| _, _, _, (prod_mk_coprod f g) =>
  prod_mk (fst_comp f) (fst_comp g)
| _, _, _, (coprod_mk_of_cat f g h) => coprod_mk_of_cat f.fst_comp g h
| _, _, _, (coprod_mk_coprod f g h) => coprod_mk_coprod f.fst_comp g h
| _, _, _, (of_cat f g h) => of_cat f.fst_comp g h

def snd_comp : {X Y Z : prod_coprod C} →
  (f : norm_hom Y Z) → norm_hom (prod X Y) Z
| _, _, _, (prod_mk_of_cat f g h) =>
  prod_mk_l (snd_comp f) (snd_comp g) h
| _, _, _, (prod_mk_prod f g h) =>
  prod_mk_l (snd_comp f) (snd_comp g) h
| _, _, _, (prod_mk_coprod f g) =>
  prod_mk (snd_comp f) (snd_comp g)
| _, _, _, (coprod_mk_of_cat f g h) => coprod_mk_of_cat f.snd_comp g h
| _, _, _, (coprod_mk_coprod f g h) => coprod_mk_coprod f.snd_comp g h
| _, _, _, (of_cat f g h) => of_cat f.snd_comp g h

theorem inl_comp_prod_mk_l : {V W X Y Z : prod_coprod C} →
  (f : norm_hom (coprod V W) X) → (g : norm_hom (coprod V W) Y) →
  (h : list_inj (prod X Y) Z) →
  inl_comp (prod_mk_l f g h) = prod_mk_l (inl_comp f) (inl_comp g) h
| _, _, _, _, _, coprod_mk_of_cat list_proj.empty f g, coprod_mk_of_cat list_proj.empty h i, j => by
rw [inl_comp, inl_comp, prod_mk_l, inl_comp_coprod_mk, inl_comp, inl_comp]
| _, _, _, _, _, coprod_mk_of_cat list_proj.empty f g, coprod_mk_coprod list_proj.empty h i, j => by
rw [inl_comp, inl_comp, prod_mk_l, inl_comp_coprod_mk, inl_comp, inl_comp]
| _, _, _, _, _, coprod_mk_coprod list_proj.empty f g, coprod_mk_coprod list_proj.empty h i, j => by
rw [inl_comp, inl_comp, prod_mk_l, inl_comp_coprod_mk, inl_comp, inl_comp]
| _, _, _, _, _, coprod_mk_coprod list_proj.empty f g, coprod_mk_of_cat list_proj.empty h i, j => by
rw [inl_comp, inl_comp, prod_mk_l, inl_comp_coprod_mk, inl_comp, inl_comp]
| _, _, _, _, _, prod_mk_coprod f g, h, i => by
rw [inl_comp, prod_mk_l, inl_comp_coprod_mk, inl_comp]
| _, _, _, _, _, coprod_mk_coprod f g h, i, j => by
rw [prod_mk_l, inl_comp_coprod_mk]
| _, _, _, _, _, coprod_mk_of_cat f g h, i, j =>
by rw [prod_mk_l, inl_comp_coprod_mk]

theorem inr_comp_prod_mk_l : {V W X Y Z : prod_coprod C} →
  (f : norm_hom (coprod V W) X) → (g : norm_hom (coprod V W) Y) →
  (h : list_inj (prod X Y) Z) →
  inr_comp (prod_mk_l f g h) = prod_mk_l (inr_comp f) (inr_comp g) h
| _, _, _, _, _, coprod_mk_of_cat list_proj.empty f g, coprod_mk_of_cat list_proj.empty h i, j => by
rw [inr_comp, inr_comp, prod_mk_l, inr_comp_coprod_mk, inr_comp, inr_comp]
| _, _, _, _, _, coprod_mk_of_cat list_proj.empty f g, coprod_mk_coprod list_proj.empty h i, j => by
rw [inr_comp, inr_comp, prod_mk_l, inr_comp_coprod_mk, inr_comp, inr_comp]
| _, _, _, _, _, coprod_mk_coprod list_proj.empty f g, coprod_mk_coprod list_proj.empty h i, j => by
rw [inr_comp, inr_comp, prod_mk_l, inr_comp_coprod_mk, inr_comp, inr_comp]
| _, _, _, _, _, coprod_mk_coprod list_proj.empty f g, coprod_mk_of_cat list_proj.empty h i, j => by
rw [inr_comp, inr_comp, prod_mk_l, inr_comp_coprod_mk, inr_comp, inr_comp]
| _, _, _, _, _, prod_mk_coprod f g, h, i => by
rw [inr_comp, prod_mk_l, inr_comp_coprod_mk, inr_comp]
| _, _, _, _, _, coprod_mk_coprod f g h, i, j => by
rw [prod_mk_l, inr_comp_coprod_mk]
| _, _, _, _, _, coprod_mk_of_cat f g h, i, j =>
by rw [prod_mk_l, inr_comp_coprod_mk]

theorem fst_comp_prod_mk_l : {V W X Y Z : prod_coprod C} →
  (f : norm_hom W X) → (g : norm_hom W Y) →
  (h : list_inj (prod X Y) Z) →
  (fst_comp (prod_mk_l f g h) : norm_hom (prod W V) _) =
  prod_mk_l f.fst_comp (fst_comp g) h
| _, of_cat' _, _, _, _, f, g, h => rfl
| _, coprod _ _, _, _, (of_cat' _), f, g, h => by
rw [prod_mk_l, prod_mk_l, coprod_mk, fst_comp, ← inl_comp_prod_mk_l,
  ← inr_comp_prod_mk_l]
simp
| _, prod _ _, _, _, _, f, g, h => prod_mk_prod f g h

@[simp] def list_proj_comp : {X Y Z : prod_coprod C} → (f : list_proj X Y) →
  (g : norm_hom Y Z) → norm_hom X Z
| _, _, _, list_proj.empty, g => g
| _, _, _, list_proj.fst_comp f, g => fst_comp (list_proj_comp f g)
| _, _, _, list_proj.snd_comp f, g => snd_comp (list_proj_comp f g)

@[simp] theorem list_proj_comp_coprod_mk_of_cat : {W X Y : prod_coprod C} → {Z : C} →
  (f : list_proj W (coprod X Y)) →
  (g : norm_hom X (of_cat' Z)) → (h : norm_hom Y (of_cat' Z)) →
  list_proj_comp f (coprod_mk_of_cat empty g h) = coprod_mk_of_cat f g h
| _, _, _, _, list_proj.empty, _, _ => rfl
| _, _, _, _, (list_proj.fst_comp f), g, h =>
by rw [list_proj_comp, list_proj_comp_coprod_mk_of_cat, fst_comp]
| _, _, _, _, (list_proj.snd_comp f), g, h =>
by rw [list_proj_comp, list_proj_comp_coprod_mk_of_cat, snd_comp]

@[simp] theorem list_proj_comp_coprod_mk_coprod : {V W X Y Z : prod_coprod C} →
  (f : list_proj V (coprod W X)) →
  (g : norm_hom W (coprod Y Z)) → (h : norm_hom X (coprod Y Z)) →
  list_proj_comp f (coprod_mk_coprod empty g h) = coprod_mk_coprod f g h
| _, _, _, _, _, list_proj.empty, _, _ => rfl
| _, _, _, _, _, (list_proj.fst_comp f), g, h =>
by rw [list_proj_comp, list_proj_comp_coprod_mk_coprod, fst_comp]
| _, _, _, _, _, (list_proj.snd_comp f), g, h =>
by rw [list_proj_comp, list_proj_comp_coprod_mk_coprod, snd_comp]

@[simp] theorem list_proj_comp_of_cat : {W : prod_coprod C} → {X Y : C} → {Z : prod_coprod C} →
  (f : list_proj W (of_cat' X)) → (g : X ⟶ Y) →
  (h : list_inj (of_cat' Y) Z) →
  list_proj_comp f (of_cat empty g h) = of_cat f g h
| _, _, _, _, list_proj.empty, _, _ => rfl
| _, _, _, _, (list_proj.fst_comp f), g, h =>
by rw [list_proj_comp, list_proj_comp_of_cat, fst_comp]
| _, _, _, _, (list_proj.snd_comp f), g, h =>
by rw [list_proj_comp, list_proj_comp_of_cat, snd_comp]

def comp_inl : {X Y Z : prod_coprod C} →
  (f : norm_hom X Y) → norm_hom X (coprod Y Z)
| _, _, _, (coprod_mk_of_cat f g h) =>
  coprod_mk_l f (comp_inl g) (comp_inl h)
| _, _, _, (coprod_mk_coprod f g h) =>
  coprod_mk_l f (comp_inl g) (comp_inl h)
| _, _, _, (prod_mk_of_cat f g h) => prod_mk_of_cat f g h.comp_inl
| _, _, _, (prod_mk_prod f g h) => prod_mk_prod f g h.comp_inl
| _, _, _, (prod_mk_coprod f g) =>
  prod_mk_l f g list_inj.empty.comp_inl
| _, _, _, (of_cat f g h) => of_cat f g h.comp_inl

def comp_inr : {X Y Z : prod_coprod C} →
  (f : norm_hom X Z) → norm_hom X (coprod Y Z)
| _, _, _, (coprod_mk_of_cat f g h) =>
  coprod_mk_l f (comp_inr g) (comp_inr h)
| _, _, _, (coprod_mk_coprod f g h) =>
  coprod_mk_l f (comp_inr g) (comp_inr h)
| _, _, _, (prod_mk_of_cat f g h) => prod_mk_of_cat f g h.comp_inr
| _, _, _, (prod_mk_prod f g h) => prod_mk_prod f g h.comp_inr
| _, _, _, (prod_mk_coprod f g) =>
  prod_mk_l f g list_inj.empty.comp_inr
| _, _, _, (of_cat f g h) => of_cat f g h.comp_inr

theorem inl_comp_comp_inl : {W X Y Z : prod_coprod C} → (f : norm_hom (coprod W X) Y) →
  (inl_comp (comp_inl f) : norm_hom W (coprod Y Z)) = comp_inl (inl_comp f)
| _, _, _, _, coprod_mk_of_cat list_proj.empty _ _ => rfl
| _, _, _, _, coprod_mk_coprod list_proj.empty _ _ => rfl
| W, _, _, _, prod_mk_coprod _ _ => by
rw [comp_inl, inl_comp, prod_mk_l, inl_comp_coprod_mk]
cases W <;> rfl

theorem inl_comp_comp_inr : {W X Y Z : prod_coprod C} → (f : norm_hom (coprod W X) Z) →
  (inl_comp (comp_inr f) : norm_hom W (coprod Y Z)) = comp_inr (inl_comp f)
| _, _, _, _, coprod_mk_of_cat list_proj.empty _ _ => rfl
| _, _, _, _, coprod_mk_coprod list_proj.empty _ _ => rfl
| W, _, _, _, prod_mk_coprod _ _ => by
rw [comp_inr, inl_comp, prod_mk_l, inl_comp_coprod_mk]
cases W <;> rfl

theorem inr_comp_comp_inl : {W X Y Z : prod_coprod C} → (f : norm_hom (coprod X W) Y) →
  (inr_comp (comp_inl f) : norm_hom W (coprod Y Z)) = comp_inl (inr_comp f)
| _, _, _, _, coprod_mk_of_cat list_proj.empty _ _ => rfl
| _, _, _, _, coprod_mk_coprod list_proj.empty _ _ => rfl
| W, _, _, _, prod_mk_coprod _ _ => by
rw [comp_inl, inr_comp, prod_mk_l, inr_comp_coprod_mk]
cases W <;> rfl

theorem inr_comp_comp_inr : {W X Y Z : prod_coprod C} → (f : norm_hom (coprod X W) Z) →
  (inr_comp (comp_inr f) : norm_hom W (coprod Y Z)) = comp_inr (inr_comp f)
| _, _, _, _, coprod_mk_of_cat list_proj.empty _ _ => rfl
| _, _, _, _, coprod_mk_coprod list_proj.empty _ _ => rfl
| W, _, _, _, prod_mk_coprod _ _ => by
rw [comp_inr, inr_comp, prod_mk_l, inr_comp_coprod_mk]
cases W <;> rfl

theorem fst_comp_comp_inl : {W X Y Z : prod_coprod C} → (f : norm_hom W Y) →
  (fst_comp (comp_inl f) : norm_hom (prod W X) (coprod Y Z)) = comp_inl (fst_comp f)
| _, _, _, _, coprod_mk_of_cat f g h => rfl
| _, _, _, _, coprod_mk_coprod f g h => rfl
| _, _, _, _, prod_mk_of_cat f g h => rfl
| _, _, _, _, prod_mk_prod f g h => rfl
| coprod A B, _, _, _, prod_mk_coprod f g => by
rw [comp_inl, fst_comp, prod_mk_l, prod_mk, comp_inl,
  coprod_mk_prod_mk_l]

| _, _, _, _, of_cat f g h => rfl

protected def id : (X : prod_coprod C) → norm_hom X X
| (of_cat' X) => of_cat empty (𝟙 X) empty
| (prod X Y) => prod_mk (fst_comp (norm_hom.id X)) (snd_comp (norm_hom.id Y))
| (coprod X Y) => coprod_mk (comp_inl (norm_hom.id X)) (comp_inr (norm_hom.id Y))

@[simp] def comp_list_inj : {X Y Z : prod_coprod C} → (f : norm_hom X Y) → (g : list_inj Y Z) →
  norm_hom X Z
| _, _, _, f, list_inj.empty => f
| _, _, _, f, list_inj.comp_inl g => comp_inl (comp_list_inj f g)
| _, _, _, f, list_inj.comp_inr g => comp_inr (comp_list_inj f g)

@[simp] theorem comp_list_inj_prod_mk_of_cat : {W : C} → {X Y Z : prod_coprod C} →
  (f : norm_hom (of_cat' W) X) → (g : norm_hom (of_cat' W) Y) →
  (h : list_inj (prod X Y) Z) → comp_list_inj (prod_mk_of_cat f g empty) h = prod_mk_of_cat f g h
| _, _, _, _, _, _, list_inj.empty => by simp [comp_list_inj]
| _, _, _, _, _, _, (list_inj.comp_inl h) =>
by rw [comp_list_inj, comp_list_inj_prod_mk_of_cat, comp_inl]
| _, _, _, _, _, _, (list_inj.comp_inr h) =>
by rw [comp_list_inj, comp_list_inj_prod_mk_of_cat, comp_inr]

@[simp] theorem comp_list_inj_prod_mk_prod : {V W X Y Z : prod_coprod C} →
  (f : norm_hom (prod V W) X) → (g : norm_hom (prod V W) Y) →
  (h : list_inj (prod X Y) Z) →
  comp_list_inj (prod_mk_prod f g empty) h = prod_mk_prod f g h
| _, _, _, _, _, _, _, list_inj.empty => by simp
| _, _, _, _, _, _, _, (list_inj.comp_inl h) =>
by rw [comp_list_inj, comp_list_inj_prod_mk_prod, comp_inl]
| _, _, _, _, _, _, _, (list_inj.comp_inr h) =>
by rw [comp_list_inj, comp_list_inj_prod_mk_prod, comp_inr]

@[simp] theorem comp_list_inj_of_cat : {W : prod_coprod C} → {X Y : C} → {Z : prod_coprod C} →
  (f : list_proj W (of_cat' X)) → (g : X ⟶ Y) →
  (h : list_inj (of_cat' Y) Z) →
  comp_list_inj (of_cat f g empty) h = of_cat f g h
| _, _, _, _, _, _, list_inj.empty => rfl
| _, _, _, _, _, _, (list_inj.comp_inl h) =>
by rw [comp_list_inj, comp_list_inj_of_cat, comp_inl]
| _, _, _, _, _, _, (list_inj.comp_inr h) =>
by rw [comp_list_inj, comp_list_inj_of_cat, comp_inr]

def get_proj_of_cat : {X Y : prod_coprod C} → {Z : C} →
  (f : norm_hom (prod X Y) (of_cat' Z)) →
  norm_hom X (of_cat' Z) ⊕ norm_hom Y (of_cat' Z)
| _, _, _, (coprod_mk_of_cat (list_proj.fst_comp f) g h) =>
  Sum.inl (coprod_mk_of_cat f g h)
| _, _, _, (coprod_mk_of_cat (list_proj.snd_comp f) g h) =>
  Sum.inr (coprod_mk_of_cat f g h)
| _, _, _, (of_cat (list_proj.fst_comp f) g h) =>
  Sum.inl (of_cat f g h)
| _, _, _, (of_cat (list_proj.snd_comp f) g h) =>
  Sum.inr (of_cat f g h)

def get_inj_of_cat : {X : C} → {Y Z : prod_coprod C} →
  (f : norm_hom (of_cat' X) (coprod Y Z)) →
  norm_hom (of_cat' X) Y ⊕ norm_hom (of_cat' X) Z
| _, _, _, (prod_mk_of_cat f g (list_inj.comp_inl h)) =>
  Sum.inl (prod_mk_of_cat f g h)
| _, _, _, (prod_mk_of_cat f g (list_inj.comp_inr h)) =>
  Sum.inr (prod_mk_of_cat f g h)
| _, _, _, (of_cat f g (list_inj.comp_inl h)) =>
  Sum.inl (of_cat f g h)
| _, _, _, (of_cat f g (list_inj.comp_inr h)) =>
  Sum.inr (of_cat f g h)

end norm_hom

inductive norm_hom2 : (X Y : prod_coprod C) → Type
| of_cat {X Y : C} (f : X ⟶ Y) : norm_hom2 (of_cat' X) (of_cat' Y)
| coprod_mk {X Y Z : prod_coprod C} (f : norm_hom2 X Z) (g : norm_hom2 Y Z) :
  norm_hom2 (X.coprod Y) Z
| comp_inl {X Y Z : prod_coprod C} (f : norm_hom2 X Y) :
  norm_hom2 X (coprod Y Z)
| comp_inr {X Y Z : prod_coprod C} (f : norm_hom2 X Z) :
  norm_hom2 X (coprod Y Z)
| prod_mk {X Y Z : prod_coprod C} (f : norm_hom2 X Y) (g : norm_hom2 X Z) :
  norm_hom2 X (prod Y Z)
| fst_comp {X Y Z : prod_coprod C} (f : norm_hom2 X Z) :
  norm_hom2 (prod X Y) Z
| snd_comp {X Y Z : prod_coprod C} (f : norm_hom2 Y Z) :
  norm_hom2 (prod X Y) Z

namespace norm_hom2

@[simp] def list_proj_comp : {X Y Z : prod_coprod C} → (f : list_proj X Y) →
  (g : norm_hom2 Y Z) → norm_hom2 X Z
| _, _, _, list_proj.empty, g => g
| _, _, _, list_proj.fst_comp f, g => fst_comp (list_proj_comp f g)
| _, _, _, list_proj.snd_comp f, g => snd_comp (list_proj_comp f g)

@[simp] def comp_list_inj : {X Y Z : prod_coprod C} → (f : norm_hom2 X Y) → (g : list_inj Y Z) →
  norm_hom2 X Z
| _, _, _, f, list_inj.empty => f
| _, _, _, f, list_inj.comp_inl g => comp_inl (comp_list_inj f g)
| _, _, _, f, list_inj.comp_inr g => comp_inr (comp_list_inj f g)

end norm_hom2

@[simp] def norm_hom.to_norm_hom2 : {X Y : prod_coprod C} → (f : norm_hom X Y) → norm_hom2 X Y
| _, _, (norm_hom.of_cat f g h) => (norm_hom2.list_proj_comp f (norm_hom2.of_cat g)).comp_list_inj h
| _, _, (norm_hom.prod_mk_of_cat f g h) =>
  norm_hom2.comp_list_inj (norm_hom2.prod_mk (to_norm_hom2 f) (to_norm_hom2 g)) h
| _, _, (norm_hom.prod_mk_prod f g h) =>
  norm_hom2.comp_list_inj (norm_hom2.prod_mk (to_norm_hom2 f) (to_norm_hom2 g)) h
| _, _, (norm_hom.prod_mk_coprod f g) =>
  norm_hom2.prod_mk (to_norm_hom2 f) (to_norm_hom2 g)
| _, _, (norm_hom.coprod_mk_of_cat f g h) =>
  norm_hom2.list_proj_comp f (norm_hom2.coprod_mk (to_norm_hom2 g) (to_norm_hom2 h))
| _, _, (norm_hom.coprod_mk_coprod f g h) =>
  norm_hom2.list_proj_comp f (norm_hom2.coprod_mk (to_norm_hom2 g) (to_norm_hom2 h))

@[simp] def norm_hom2.to_norm_hom : {X Y : prod_coprod C} → (f : norm_hom2 X Y) → norm_hom X Y
| _, _, (norm_hom2.of_cat f) => norm_hom.of_cat list_proj.empty f list_inj.empty
| _, _, (norm_hom2.comp_inl f) => norm_hom.comp_inl (to_norm_hom f)
| _, _, (norm_hom2.comp_inr f) => norm_hom.comp_inr (to_norm_hom f)
| _, _, (norm_hom2.fst_comp f) => norm_hom.fst_comp (to_norm_hom f)
| _, _, (norm_hom2.snd_comp f) => norm_hom.snd_comp (to_norm_hom f)
| _, _, (norm_hom2.prod_mk f g) => norm_hom.prod_mk (to_norm_hom f) (to_norm_hom g)
| _, _, (norm_hom2.coprod_mk f g) => norm_hom.coprod_mk (to_norm_hom f) (to_norm_hom g)

@[simp] theorem to_norm_hom_list_proj_comp {X Y Z : prod_coprod C} (f : list_proj X Y) (g : norm_hom2 Y Z) :
  (norm_hom2.list_proj_comp f g).to_norm_hom = g.to_norm_hom.list_proj_comp f :=
by induction f <;> simp [*]

@[simp] theorem to_norm_hom_comp_list_inj {X Y Z : prod_coprod C} (f : norm_hom2 X Y) (g : list_inj Y Z) :
  (norm_hom2.comp_list_inj f g).to_norm_hom = f.to_norm_hom.comp_list_inj g :=
by induction g <;> simp [*]

def norm_hom2.size : {X Y : prod_coprod C} → norm_hom2 X Y → Nat
| _, _, (norm_hom2.of_cat _) => 0
| _, _, (norm_hom2.comp_inl f) => size f + 1
| _, _, (norm_hom2.comp_inr f) => size f + 1
| _, _, (norm_hom2.fst_comp f) => size f + 1
| _, _, (norm_hom2.snd_comp f) => size f + 1
| _, _, (norm_hom2.prod_mk f g) => size f + size g + 1
| _, _, (norm_hom2.coprod_mk f g) => size f + size g + 1

def norm_hom2.comp : {X Y Z : prod_coprod C} →
  norm_hom2 X Y → norm_hom2 Y Z → norm_hom2 X Z
| _, _, _, fst_comp f, g => (comp f g).fst_comp
| _, _, _, snd_comp f, g => (comp f g).snd_comp
| _, _, _, coprod_mk f g, h => coprod_mk (comp f h) (comp g h)
| _, _, _, of_cat f, of_cat g => of_cat (f ≫ g)
| _, _, _, comp_inl f, coprod_mk g _ => comp f g
| _, _, _, comp_inr f, coprod_mk _ h => comp f h
| _, _, _, f, comp_inl g => (comp f g).comp_inl
| _, _, _, f, comp_inr g => (comp f g).comp_inr
| _, _, _, f, prod_mk g h => prod_mk (comp f g) (comp f h)
| _, _, _, prod_mk f _, fst_comp h => comp f h
| _, _, _, prod_mk _ g, snd_comp h => comp g h
termination_by comp X Y Z f g => (X.size, Y.size, Z.size)

theorem to_norm_hom_to_norm_hom2 {X Y : prod_coprod C} (f : norm_hom X Y) :
  f.to_norm_hom2.to_norm_hom = f :=
by induction f <;> simp [norm_hom.to_norm_hom2, norm_hom2.to_norm_hom, *,
   norm_hom.prod_mk, norm_hom.coprod_mk]

@[simp] theorem comp_fst_comp {W X Y Z : prod_coprod C} (f : norm_hom2 W Y)
  (g : norm_hom2 Y Z) : (f.fst_comp.comp g : norm_hom2 (prod W X) Z).to_norm_hom =
    (f.comp g).to_norm_hom.fst_comp := by
rw [norm_hom2.comp, norm_hom2.to_norm_hom]

@[simp] theorem comp_snd_comp {W X Y Z : prod_coprod C} (f : norm_hom2 X Y)
  (g : norm_hom2 Y Z) : (f.snd_comp.comp g : norm_hom2 (prod W X) Z).to_norm_hom =
    (f.comp g).to_norm_hom.snd_comp := by
rw [norm_hom2.comp, norm_hom2.to_norm_hom]

@[simp] theorem coprod_mk_comp {W X Y Z : prod_coprod C} (f : norm_hom2 W Y)
  (g : norm_hom2 X Y) (h : norm_hom2 Y Z) :
  ((f.coprod_mk g).comp h).to_norm_hom = ((f.comp h).coprod_mk (g.comp h)).to_norm_hom := by
rw [norm_hom2.comp, norm_hom2.to_norm_hom]

@[simp] theorem comp_inl_comp_coprod_mk {W X Y Z : prod_coprod C} (f : norm_hom2 W X)
  (g : norm_hom2 X Z) (h : norm_hom2 Y Z) :
  (f.comp_inl.comp (g.coprod_mk h)).to_norm_hom = (f.comp g).to_norm_hom := by
rw [norm_hom2.comp]

@[simp] theorem comp_inr_comp_coprod_mk {W X Y Z : prod_coprod C} (f : norm_hom2 W Y)
  (g : norm_hom2 X Z) (h : norm_hom2 Y Z) :
  (f.comp_inr.comp (g.coprod_mk h)).to_norm_hom = (f.comp h).to_norm_hom := by
rw [norm_hom2.comp]

@[simp] theorem HEq_Iff_Eq {α : Sort _} {a b : α} : HEq a b ↔ a = b := by
apply Iff.intro
intro h
cases h
rfl
intro h
cases h
exact HEq.refl _

@[simp] theorem comp_comp_inl {W X Y Z : prod_coprod C} (f : norm_hom2 W X)
  (g : norm_hom2 X Y) : (f.comp g.comp_inl : norm_hom2 W (coprod Y Z)).to_norm_hom =
    (f.comp g).to_norm_hom.comp_inl := by
induction f with
| of_cat f => rw [norm_hom2.comp, norm_hom2.to_norm_hom] <;> simp
| coprod_mk f h ih₁ ih₂ =>
rw [norm_hom2.comp, norm_hom2.to_norm_hom, ih₂, ih₁,
  norm_hom2.comp, norm_hom2.to_norm_hom]
apply norm_hom.ext_coprod
rw [norm_hom.inl_comp_coprod_mk, norm_hom.inl_comp_comp_inl,
  norm_hom.inl_comp_coprod_mk]
rw [norm_hom.inr_comp_coprod_mk, norm_hom.inr_comp_comp_inl,
  norm_hom.inr_comp_coprod_mk]
| comp_inl f ih =>
rw [norm_hom2.comp, norm_hom2.to_norm_hom]
intros X Y f h
cases h
simp
intros X Y f h
cases h
simp
intros X Y f h
cases h
simp
intro h
cases h
simp
intros h
cases h
simp
intros h
cases h
simp
intros h
cases h
simp
intros h
cases h
simp
| comp_inr f ih =>
rw [norm_hom2.comp, norm_hom2.to_norm_hom]
intros X Y f h
cases h
simp
intros X Y f h
cases h
simp
intros X Y f h
cases h
simp
intro h
cases h
simp
intros h
cases h
simp
intros h
cases h
simp
intros h
cases h
simp
intros h
cases h
simp
| prod_mk f h =>
rw [norm_hom2.comp, norm_hom2.to_norm_hom]
intros X Y f h
cases h
simp
intros X Y f h
cases h
simp
intros X Y f h
cases h
simp
intro h
cases h
simp
intros h
cases h
simp
intros h
cases h
simp
intros h
cases h
simp
| fst_comp f ih =>
rw [norm_hom2.comp, norm_hom2.to_norm_hom, ih, norm_hom2.comp,
  norm_hom2.to_norm_hom]

theorem norm_hom2.comp_assoc : {W X Y Z : prod_coprod C} →
  (f : norm_hom2 W X) → (g : norm_hom2 X Y) → (h : norm_hom2 Y Z) →
  ((f.comp g).comp h).to_norm_hom =
    (f.comp (g.comp h)).to_norm_hom
| _, _, _, _, fst_comp f, g, h => by
rw [comp, comp, comp, to_norm_hom, comp_assoc, to_norm_hom]
| _, _, _, _, snd_comp f, g, h => by
rw [comp, comp, comp, to_norm_hom, comp_assoc, to_norm_hom]
| _, _, _, _, coprod_mk f g, h, i => by
rw [comp, comp, comp, to_norm_hom, comp_assoc, to_norm_hom, comp_assoc]
| _, _, _, _, prod_mk f _, fst_comp h, i => by
rw [comp, comp, comp, comp_assoc]
| _, _, _, _, prod_mk f _, snd_comp h, i => by
rw [comp, comp, comp, comp_assoc]
| _, _, _, _, prod_mk _ _, prod_mk _ _, fst_comp _ => by
rw [comp, comp, comp, comp_assoc] <;>


import topology.tactic
import topology.algebra.monoid
import topology.instances.real
import analysis.special_functions.trigonometric

example {X Y : Type*} [topological_space X] [topological_space Y]
  (f₁ f₂ : X → Y) (hf₁ : continuous f₁) (hf₂ : continuous f₂)
  (g : Y → ℝ) (hg : continuous g) : continuous (λ x, (max (g (f₁ x)) (g (f₂ x))) + 1) :=
by guard_proof_term { continuity } ((hg.comp hf₁).max (hg.comp hf₂)).add continuous_const

example {κ ι : Type}
  (K : κ → Type) [∀ k, topological_space (K k)] (I : ι → Type) [∀ i, topological_space (I i)]
  (e : κ ≃ ι) (F : Π k, homeomorph (K k) (I (e k))) :
  continuous (λ (f : Π k, K k) (i : ι), F (e.symm i) (f (e.symm i))) :=
by guard_proof_term { continuity }
  @continuous_pi _ _ _ _ _ (λ (f : Π k, K k) i, (F (e.symm i)) (f (e.symm i)))
    (λ (i : ι), ((F (e.symm i)).continuous).comp (continuous_apply (e.symm i)))

open real

local attribute [continuity] continuous_exp continuous_sin continuous_cos

example : continuous (λ x : ℝ, exp ((max x (-x)) + sin x)^2) :=
by guard_proof_term { continuity }
  (continuous_exp.comp ((continuous_id.max continuous_id.neg).add continuous_sin)).pow 2

example : continuous (λ x : ℝ, exp ((max x (-x)) + sin (cos x))^2) :=
by guard_proof_term { continuity }
 (continuous_exp.comp ((continuous_id'.max continuous_id'.neg).add (continuous_sin.comp continuous_cos))).pow 2

-- Without `md := semireducible` in the call to `apply_rules` in `continuity`,
-- this last example would have run off the rails:
-- ```
-- example : continuous (λ x : ℝ, exp ((max x (-x)) + sin (cos x))^2) :=
-- by show_term { continuity! }
-- ```
-- produces lots of subgoals, including many copies of
-- ⊢ continuous complex.re
-- ⊢ continuous complex.exp
-- ⊢ continuous coe
-- ⊢ continuous (λ (x : ℝ), ↑x)


/-
Copyright (c) 2020 Oliver Nash. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Oliver Nash
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.tactic.abel
import Mathlib.PostPort

namespace Mathlib

namespace tactic

namespace interactive

/-- A tactic for simplifying identities in not-necessarily-commutative rings.

An example:
```lean
example {R : Type*} [ring R] (a b c : R) : a * (b + c + c - b) = 2*a*c :=
by noncomm_ring
```
-/


/-
Copyright (c) 2021 Riccardo Brasca. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Riccardo Brasca, Johan Commelin

! This file was ported from Lean 3 source module analysis.normed.group.SemiNormedGroup.completion
! leanprover-community/mathlib commit 17ef379e997badd73e5eabb4d38f11919ab3c4b3
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.Normed.Group.SemiNormedGroup
import Mathbin.CategoryTheory.Preadditive.AdditiveFunctor
import Mathbin.Analysis.Normed.Group.HomCompletion

/-!
# Completions of normed groups

This file contains an API for completions of seminormed groups (basic facts about
objects and morphisms).

## Main definitions

- `SemiNormedGroup.Completion : SemiNormedGroup ⥤ SemiNormedGroup` : the completion of a
  seminormed group (defined as a functor on `SemiNormedGroup` to itself).
- `SemiNormedGroup.Completion.lift (f : V ⟶ W) : (Completion.obj V ⟶ W)` : a normed group hom
  from `V` to complete `W` extends ("lifts") to a seminormed group hom from the completion of
  `V` to `W`.

## Projects

1. Construct the category of complete seminormed groups, say `CompleteSemiNormedGroup`
  and promote the `Completion` functor below to a functor landing in this category.
2. Prove that the functor `Completion : SemiNormedGroup ⥤ CompleteSemiNormedGroup`
  is left adjoint to the forgetful functor.

-/

noncomputable section

universe u

open UniformSpace MulOpposite CategoryTheory NormedAddGroupHom

namespace SemiNormedGroup

/-- The completion of a seminormed group, as an endofunctor on `SemiNormedGroup`. -/
@[simps]
def completion : SemiNormedGroup.{u} ⥤ SemiNormedGroup.{u}
    where
  obj V := SemiNormedGroup.of (completion V)
  map V W f := f.Completion
  map_id' V := completion_id
  map_comp' U V W f g := (completion_comp f g).symm
#align SemiNormedGroup.Completion SemiNormedGroup.completion

instance completion_completeSpace {V : SemiNormedGroup} : CompleteSpace (completion.obj V) :=
  Completion.completeSpace _
#align SemiNormedGroup.Completion_complete_space SemiNormedGroup.completion_completeSpace

/-- The canonical morphism from a seminormed group `V` to its completion. -/
@[simps]
def completion.incl {V : SemiNormedGroup} : V ⟶ completion.obj V
    where
  toFun v := (v : completion V)
  map_add' := Completion.coe_add
  bound' := ⟨1, fun v => by simp⟩
#align SemiNormedGroup.Completion.incl SemiNormedGroup.completion.incl

theorem completion.norm_incl_eq {V : SemiNormedGroup} {v : V} : ‖completion.incl v‖ = ‖v‖ := by simp
#align SemiNormedGroup.Completion.norm_incl_eq SemiNormedGroup.completion.norm_incl_eq

theorem completion.map_normNoninc {V W : SemiNormedGroup} {f : V ⟶ W} (hf : f.NormNoninc) :
    (completion.map f).NormNoninc :=
  NormedAddGroupHom.NormNoninc.normNoninc_iff_norm_le_one.2 <|
    (NormedAddGroupHom.norm_completion f).le.trans <|
      NormedAddGroupHom.NormNoninc.normNoninc_iff_norm_le_one.1 hf
#align SemiNormedGroup.Completion.map_norm_noninc SemiNormedGroup.completion.map_normNoninc

/-- Given a normed group hom `V ⟶ W`, this defines the associated morphism
from the completion of `V` to the completion of `W`.
The difference from the definition obtained from the functoriality of completion is in that the
map sending a morphism `f` to the associated morphism of completions is itself additive. -/
def completion.mapHom (V W : SemiNormedGroup.{u}) :
    (V ⟶ W) →+ (completion.obj V ⟶ completion.obj W) :=
  AddMonoidHom.mk' (CategoryTheory.Functor.map completion) fun f g => f.completion_add g
#align SemiNormedGroup.Completion.map_hom SemiNormedGroup.completion.mapHom

@[simp]
theorem completion.map_zero (V W : SemiNormedGroup) : completion.map (0 : V ⟶ W) = 0 :=
  (completion.mapHom V W).map_zero
#align SemiNormedGroup.Completion.map_zero SemiNormedGroup.completion.map_zero

instance : Preadditive SemiNormedGroup.{u}
    where
  homGroup P Q := inferInstance
  add_comp := by
    intros
    ext
    simp only [NormedAddGroupHom.add_apply, CategoryTheory.comp_apply, map_add]
  comp_add := by
    intros
    ext
    simp only [NormedAddGroupHom.add_apply, CategoryTheory.comp_apply, map_add]

instance : Functor.Additive completion where map_add' X Y := (completion.mapHom _ _).map_add

/-- Given a normed group hom `f : V → W` with `W` complete, this provides a lift of `f` to
the completion of `V`. The lemmas `lift_unique` and `lift_comp_incl` provide the api for the
universal property of the completion. -/
def completion.lift {V W : SemiNormedGroup} [CompleteSpace W] [SeparatedSpace W] (f : V ⟶ W) :
    completion.obj V ⟶ W where
  toFun := f.extension
  map_add' := f.extension.toAddMonoidHom.map_add'
  bound' := f.extension.bound'
#align SemiNormedGroup.Completion.lift SemiNormedGroup.completion.lift

theorem completion.lift_comp_incl {V W : SemiNormedGroup} [CompleteSpace W] [SeparatedSpace W]
    (f : V ⟶ W) : completion.incl ≫ completion.lift f = f :=
  by
  ext
  apply NormedAddGroupHom.extension_coe
#align SemiNormedGroup.Completion.lift_comp_incl SemiNormedGroup.completion.lift_comp_incl

theorem completion.lift_unique {V W : SemiNormedGroup} [CompleteSpace W] [SeparatedSpace W]
    (f : V ⟶ W) (g : completion.obj V ⟶ W) : completion.incl ≫ g = f → g = completion.lift f :=
  fun h => (NormedAddGroupHom.extension_unique _ fun v => ((ext_iff.1 h) v).symm).symm
#align SemiNormedGroup.Completion.lift_unique SemiNormedGroup.completion.lift_unique

end SemiNormedGroup


import .util

namespace lawvere
    open function
    open classical (em)

    open util
    universes u v

    -- properties of functions:
    structure func_prop :=
        (P: Π {A B: Sort _}, (A → B) → Prop)
        (elim_comp:
            ∀ {A B C: Sort _},
            ∀ {f: B → C},
            ∀ {g: A → B},
            P f →
            P g →
            P (f ∘ g))
        (elim_id:
            ∀ {A: Sort _},
            (∃ {B: Sort _} (f: A → B), P f) →
            P (λ x: A, x))
        (elim_pair:
            ∀ {A B C: Sort _},
            ∀ {f: A → B},
            ∀ {g: A → C},
            P f →
            P g →
            P (λ a: A, (f a, g a)))
        (elim_unpair:
            ∀ {A B C: Sort _},
            ∀ {f: A → Σ' f: B → C, P f},
            P f →
            P (λ aa: A × B, (f aa.1).1 aa.2))

    instance func_prop.has_coe_to_fun:
        has_coe_to_fun func_prop := {
            F := λ P, Π {A B: Sort _}, (A → B) → Prop,
            coe := λ P, P.P,
        }

    @[simp] theorem func_prop.coe_elim (P: func_prop) {A B: Sort _} (f: A → B):
        P f = P.P f := rfl

    -- functions with properties:
    @[reducible] def func (A B: Sort _) (P: func_prop): Sort _ :=
        Σ' f: A → B,
        P f

    @[reducible] def func.f {A B: Sort _} {P: func_prop} (f: func A B P):
        A → B := f.1

    @[reducible] def func.prop {A B: Sort _} {P: func_prop} (f: func A B P):
        P f.f := f.2

    instance func.has_coe_to_fun (A B: Sort _) (P: func_prop):
        has_coe_to_fun (func A B P) := {
            F := λ f, A → B,
            coe := λ f, f.f,
        }

    @[simp] theorem func.coe_elim {A B: Sort _} {P: func_prop} (f: func A B P) (x: A):
        f x = f.f x := rfl

    -- lawvere's theorem:
    theorem func_prop.elim_diag (P: func_prop):
        ∀ {A B: Sort _},
        ∀ {f: func A (func A B P) P},
        P f →
        P (λ a: A, f a a) :=
            assume A B: Sort _,
            assume f: func A (func A B P) P,
            assume Pf: P f,
            let f': func (A × A) B P := (|
                λ aa: A × A, f aa.1 aa.2,
                begin
                    apply P.elim_unpair,
                    exact Pf,
                end,
            |) in
            begin
                have hf': ∀ a a': A, f' (a, a') = f a a', by {
                    intros,
                    refl,
                },
                have hfunc: (λ a, f a a) = (λ a, f' (a, a)), by {
                    funext,
                    rw [hf'],
                },
                rw [hfunc],
                apply P.elim_comp,
                exact f'.prop,
                apply P.elim_pair;
                apply P.elim_id,
                all_goals {
                    apply exists.intro (func A B P),
                    apply exists.intro f.f,
                    exact f.prop,
                },
            end

    @[reducible] def func_prop.fixpt_prop (P: func_prop) (A: Sort _): Prop :=
        ∀ h: func A A P,
        ∃ a: A,
        a = h a

    theorem lawvere {X: Sort _} {A: Sort _} {P: func_prop}:
        ∀ {f: func X (func X A P) P},
        surjective f →
        P.fixpt_prop A :=
            assume f: func X (func X A P) P,
            assume sur_f: surjective f,
            assume h: func A A P,
            let g: func X A P := (|
                λ x: X, h (f x x),
                begin
                    simp,
                    apply P.elim_comp,
                    exact h.prop,
                    apply P.elim_diag,
                    exact f.prop,
                end,
            |) in
            exists.elim (sur_f g) (
                assume x: X,
                assume hfx: f x = g,
                let a: A := f x x in
                exists.intro a (
                    calc a = f x x:     rfl
                    ... = (f x).f x:    rfl
                    ... = g.f x:        by rw [hfx]
                    ... = h (f x x):    rfl
                    ... = h a:          rfl
                )
            )

    -- simple lawvere:
    @[reducible] def fixpt_prop (A: Sort _): Prop :=
        ∀ h: A → A,
        ∃ a: A,
        a = h a

    def triv_prop: func_prop := {
        P := λ A B f, true,
        elim_comp := begin
            intros,
            trivial,
        end,
        elim_id := begin
            intros,
            trivial,
        end,
        elim_pair := begin
            intros,
            trivial,
        end,
        elim_unpair := begin
            intros,
            trivial,
        end,
    }

    @[reducible] def triv_func (A B: Sort _): Sort _ :=
        func A B triv_prop

    @[reducible] def triv_func.mk {A B: Sort _} (f: A → B):
        triv_func A B := (|
            f,
            trivial,
        |)

    theorem simple_lawvere_base {X: Sort _} {A: Sort _}:
        ∀ {f: triv_func X (triv_func X A)},
        surjective f →
        fixpt_prop A := begin
            intros f sur_f h,
            have law_f := lawvere sur_f,
            have fix_h := law_f (triv_func.mk h),
            apply exists.elim fix_h,
            intros x hx,
            apply exists.intro x,
            simp at hx,
            rw [triv_func.mk, func.f] at hx,
            simp at hx,
            exact hx,
        end

    theorem simple_lawvere {X: Type (max u v)} {A: Type (max u v)}:
        ∀ {f: X → X → A},
        surjective f →
        fixpt_prop A :=
            assume f: X → X → A,
            assume sur_f: surjective f,
            let f' := triv_func.mk (λ x1: X, triv_func.mk (λ x2: X, f x1 x2)) in
            have sur_f': surjective f', by {
                intro h,
                apply exists.elim (sur_f h.f),
                intros x hx,
                apply exists.intro x,
                have f'f: f'.f = λ x1: X, triv_func.mk (λ x2: X, f x1 x2) := rfl,
                simp [f'f, hx],
                induction h,
                simp [func.f, triv_func.mk],
            },
            simple_lawvere_base sur_f'

    -- domain/codomain properties:
    def dom_cod_prop (P: Π A B: Sort _, Prop)
        (Ptrans: transitive P)
        (Psemirefl:
            ∀ {A B: Sort _},
            P A B →
            P A A)
        (Pprod:
            ∀ {A B C: Sort _},
            P A B →
            P A C →
            P A (B × C))
        (Punprod:
            ∀ {A B C D: Sort _},
            P A D →
            (isempty A ∨ P B C) →
            P (A × B) C):
        func_prop := {
            P := λ A B f, P A B,
            elim_comp := begin
                intros A B C f g hBC hAB,
                exact Ptrans hAB hBC,
            end,
            elim_id := begin
                intros A hex,
                apply exists.elim hex,
                intros B hB,
                apply exists.elim hB,
                intros f hA,
                apply Psemirefl,
                exact hA,
            end,
            elim_pair := begin
                intros A B C f g hA hA',
                apply Pprod,
                exact hA,
                exact hA',
            end,
            elim_unpair := begin
                intros A B C f hA,
                apply Punprod,
                exact hA,
                cases em (nonempty A),
                case or.inl {
                    apply h.elim,
                    intro a,
                    have hBC := (f a).2,
                    right,
                    exact hBC,
                },
                case or.inr {
                    left,
                    exact h,
                },
            end,
        }

    -- product of:
    inductive product_of (X: Sort _): Sort _ → Prop
    | exact: product_of X
    | prod {A B: Sort _} (hA: product_of A) (hB: product_of B): product_of (A × B)

    @[refl] theorem product_of.refl (A: Sort _):
        product_of A A := product_of.exact A

    @[simp] theorem nonempty_product (A B: Sort _):
        nonempty (A × B) ↔ nonempty A ∧ nonempty B := begin
            apply iff.intro,
            {
                intro hAB,
                apply hAB.elim,
                intro ab,
                split,
                exact nonempty.intro ab.1,
                exact nonempty.intro ab.2,
            },
            {
                intro hAB,
                apply hAB.2.elim,
                apply hAB.1.elim,
                intros a b,
                exact nonempty.intro (a, b),
            },
        end

    @[simp] theorem isempty_product (A B: Sort _):
        isempty (A × B) ↔ isempty A ∨ isempty B := by simp [isempty]

    theorem product_of.nonempty {X A: Sort _} (hA: product_of X A):
        nonempty A ↔ nonempty X := begin
            apply iff.intro,
            {
                intro hne,
                apply hne.elim,
                intro a,
                induction hA,
                case product_of.exact {
                    apply nonempty.intro a,
                },
                case product_of.prod {
                    simp at hne,
                    apply hA_ih_hA,
                    exact hne.1,
                    exact a.1,
                },
            },
            {
                intro hne,
                induction hA,
                case product_of.exact {
                    exact hne,
                },
                case product_of.prod {
                    simp,
                    split;
                    assumption,
                },
            },
        end

    -- restricted domain:
    def restricted_dom {dom: Sort _} (hdom: nonempty dom):
        func_prop := begin
            apply dom_cod_prop (λ A B, product_of dom A),
            {
                intros A B C hA hB,
                exact hA,
            },
            {
                intros A B hA,
                exact hA,
            },
            {
                intros A B C hA hA',
                exact hA,
            },
            {
                intros A B C D hA hB,
                simp at hB,
                cases hB,
                case or.inl {
                    apply false.elim,
                    apply hB,
                    induction hA,
                    case product_of.exact {
                        exact hdom,
                    },
                    case product_of.prod {
                        simp at *,
                        split,
                        {
                            cases hB,
                            case or.inl {
                                apply hA_ih_hA,
                                contradiction,
                            },
                            case or.inr {
                                exact hA_hA.nonempty.mpr hdom,
                            },
                        },
                        {
                            cases hB,
                            case or.inl {
                                apply hA_ih_hB,
                                have hB' := hA_ih_hA hB,
                                contradiction,
                            },
                            case or.inr {
                                exact hA_hB.nonempty.mpr hdom,
                            },
                        },
                    },
                },
                case or.inr {
                    apply product_of.prod;
                    assumption,
                },
            },
        end
end lawvere


/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro, Jeremy Avigad, Simon Hudon
-/
import data.part
import data.rel

/-!
# Partial functions

This file defines partial functions. Partial functions are like functions, except they can also be
"undefined" on some inputs. We define them as functions `α → part β`.

## Definitions

* `pfun α β`: Type of partial functions from `α` to `β`. Defined as `α → part β` and denoted
  `α →. β`.
* `pfun.dom`: Domain of a partial function. Set of values on which it is defined. Not to be confused
  with the domain of a function `α → β`, which is a type (`α` presently).
* `pfun.fn`: Evaluation of a partial function. Takes in an element and a proof it belongs to the
  partial function's `dom`.
* `pfun.as_subtype`: Returns a partial function as a function from its `dom`.
* `pfun.eval_opt`: Returns a partial function with a decidable `dom` as a function `a → option β`.
* `pfun.lift`: Turns a function into a partial function.
* `pfun.restrict`: Restriction of a partial function to a smaller `dom`.
* `pfun.res`: Turns a function into a partial function with a prescribed domain.
* `pfun.fix` : First return map of a partial function `f : α →. β ⊕ α`.
* `pfun.fix_induction`: A recursion principle for `pfun.fix`.

### Partial functions as relations

Partial functions can be considered as relations, so we specialize some `rel` definitions to `pfun`:
* `pfun.image`: Image of a set under a partial function.
* `pfun.ran`: Range of a partial function.
* `pfun.preimage`: Preimage of a set under a partial function.
* `pfun.core`: Core of a set under a partial function.
* `pfun.graph`: Graph of a partial function `a →. β`as a `set (α × β)`.
* `pfun.graph'`: Graph of a partial function `a →. β`as a `rel α β`.

### `pfun α` as a monad

Monad operations:
* `pfun.pure`: The monad `pure` function, the constant `x` function.
* `pfun.bind`: The monad `bind` function, pointwise `part.bind`
* `pfun.map`: The monad `map` function, pointwise `part.map`.
-/

/-- `pfun α β`, or `α →. β`, is the type of partial functions from
  `α` to `β`. It is defined as `α → part β`. -/
def pfun (α β : Type*) := α → part β

infixr ` →. `:25 := pfun

namespace pfun
variables {α β γ : Type*}

instance : inhabited (α →. β) := ⟨λ a, part.none⟩

/-- The domain of a partial function -/
def dom (f : α →. β) : set α := {a | (f a).dom}

theorem mem_dom (f : α →. β) (x : α) : x ∈ dom f ↔ ∃ y, y ∈ f x :=
by simp [dom, part.dom_iff_mem]

theorem dom_eq (f : α →. β) : dom f = {x | ∃ y, y ∈ f x} :=
set.ext (mem_dom f)

/-- Evaluate a partial function -/
def fn (f : α →. β) (x) (h : dom f x) : β := (f x).get h

/-- Evaluate a partial function to return an `option` -/
def eval_opt (f : α →. β) [D : decidable_pred (∈ dom f)] (x : α) : option β :=
@part.to_option _ _ (D x)

/-- Partial function extensionality -/
theorem ext' {f g : α →. β}
  (H1 : ∀ a, a ∈ dom f ↔ a ∈ dom g)
  (H2 : ∀ a p q, f.fn a p = g.fn a q) : f = g :=
funext $ λ a, part.ext' (H1 a) (H2 a)

theorem ext {f g : α →. β} (H : ∀ a b, b ∈ f a ↔ b ∈ g a) : f = g :=
funext $ λ a, part.ext (H a)

/-- Turns a partial function into a function out of its domain. -/
def as_subtype (f : α →. β) (s : f.dom) : β := f.fn s s.2

/-- The type of partial functions `α →. β` is equivalent to
the type of pairs `(p : α → Prop, f : subtype p → β)`. -/
def equiv_subtype : (α →. β) ≃ (Σ p : α → Prop, subtype p → β) :=
⟨λ f, ⟨λ a, (f a).dom, as_subtype f⟩,
 λ f x, ⟨f.1 x, λ h, f.2 ⟨x, h⟩⟩,
 λ f, funext $ λ a, part.eta _,
 λ ⟨p, f⟩, by dsimp; congr; funext a; cases a; refl⟩

theorem as_subtype_eq_of_mem {f : α →. β} {x : α} {y : β} (fxy : y ∈ f x) (domx : x ∈ f.dom) :
  f.as_subtype ⟨x, domx⟩ = y :=
part.mem_unique (part.get_mem _) fxy

/-- Turn a total function into a partial function. -/
protected def lift (f : α → β) : α →. β := λ a, part.some (f a)

instance : has_coe (α → β) (α →. β) := ⟨pfun.lift⟩

@[simp] theorem lift_eq_coe (f : α → β) : pfun.lift f = f := rfl

@[simp] theorem coe_val (f : α → β) (a : α) :
  (f : α →. β) a = part.some (f a) := rfl

/-- Graph of a partial function `f` as the set of pairs `(x, f x)` where `x` is in the domain of
`f`. -/
def graph (f : α →. β) : set (α × β) := {p | p.2 ∈ f p.1}

/-- Graph of a partial function as a relation. `x` and `y` are related iff `f x` is defined and
"equals" `y`. -/
def graph' (f : α →. β) : rel α β := λ x y, y ∈ f x

/-- The range of a partial function is the set of values
  `f x` where `x` is in the domain of `f`. -/
def ran (f : α →. β) : set β := {b | ∃ a, b ∈ f a}

/-- Restrict a partial function to a smaller domain. -/
def restrict (f : α →. β) {p : set α} (H : p ⊆ f.dom) : α →. β :=
λ x, (f x).restrict (x ∈ p) (@H x)

@[simp]
theorem mem_restrict {f : α →. β} {s : set α} (h : s ⊆ f.dom) (a : α) (b : β) :
  b ∈ f.restrict h a ↔ a ∈ s ∧ b ∈ f a :=
by simp [restrict]

/-- Turns a function into a partial function with a prescribed domain. -/
def res (f : α → β) (s : set α) : α →. β :=
(pfun.lift f).restrict s.subset_univ

theorem mem_res (f : α → β) (s : set α) (a : α) (b : β) :
  b ∈ res f s a ↔ (a ∈ s ∧ f a = b) :=
by simp [res, @eq_comm _ b]

theorem res_univ (f : α → β) : pfun.res f set.univ = f :=
rfl

theorem dom_iff_graph (f : α →. β) (x : α) : x ∈ f.dom ↔ ∃ y, (x, y) ∈ f.graph :=
part.dom_iff_mem

theorem lift_graph {f : α → β} {a b} : (a, b) ∈ (f : α →. β).graph ↔ f a = b :=
show (∃ (h : true), f a = b) ↔ f a = b, by simp

/-- The monad `pure` function, the total constant `x` function -/
protected def pure (x : β) : α →. β := λ _, part.some x

/-- The monad `bind` function, pointwise `part.bind` -/
def bind (f : α →. β) (g : β → α →. γ) : α →. γ :=
λ a, (f a).bind (λ b, g b a)

/-- The monad `map` function, pointwise `part.map` -/
def map (f : β → γ) (g : α →. β) : α →. γ :=
λ a, (g a).map f

instance : monad (pfun α) :=
{ pure := @pfun.pure _,
  bind := @pfun.bind _,
  map := @pfun.map _ }

instance : is_lawful_monad (pfun α) :=
{ bind_pure_comp_eq_map := λ β γ f x, funext $ λ a, part.bind_some_eq_map _ _,
  id_map := λ β f, by funext a; dsimp [functor.map, pfun.map]; cases f a; refl,
  pure_bind := λ β γ x f, funext $ λ a, part.bind_some.{u_1 u_2} _ (f x),
  bind_assoc := λ β γ δ f g k,
    funext $ λ a, (f a).bind_assoc (λ b, g b a) (λ b, k b a) }

theorem pure_defined (p : set α) (x : β) : p ⊆ (@pfun.pure α _ x).dom := p.subset_univ

theorem bind_defined {α β γ} (p : set α) {f : α →. β} {g : β → α →. γ}
  (H1 : p ⊆ f.dom) (H2 : ∀ x, p ⊆ (g x).dom) : p ⊆ (f >>= g).dom :=
λ a ha, (⟨H1 ha, H2 _ ha⟩ : (f >>= g).dom a)

/-- First return map. Transforms a partial function `f : α →. β ⊕ α` into the partial function
`α →. β` which sends `a : α` to the first value in `β` it hits by iterating `f`, if such a value
exists. By abusing notation to illustrate, either `f a` is in the `β` part of `β ⊕ α` (in which
case `f.fix a` returns `f a`), or it is undefined (in which case `f.fix a` is undefined as well), or
it is in the `α` part of `β ⊕ α` (in which case we repeat the procedure, so `f.fix a` will return
`f.fix (f a)`). -/
def fix (f : α →. β ⊕ α) : α →. β := λ a,
part.assert (acc (λ x y, sum.inr x ∈ f y) a) $ λ h,
@well_founded.fix_F _ (λ x y, sum.inr x ∈ f y) _
  (λ a IH, part.assert (f a).dom $ λ hf,
    by cases e : (f a).get hf with b a';
      [exact part.some b, exact IH _ ⟨hf, e⟩])
  a h

theorem dom_of_mem_fix {f : α →. β ⊕ α} {a : α} {b : β}
  (h : b ∈ f.fix a) : (f a).dom :=
let ⟨h₁, h₂⟩ := part.mem_assert_iff.1 h in
by rw well_founded.fix_F_eq at h₂; exact h₂.fst.fst

theorem mem_fix_iff {f : α →. β ⊕ α} {a : α} {b : β} :
  b ∈ f.fix a ↔ sum.inl b ∈ f a ∨ ∃ a', sum.inr a' ∈ f a ∧ b ∈ f.fix a' :=
⟨λ h, let ⟨h₁, h₂⟩ := part.mem_assert_iff.1 h in
  begin
    rw well_founded.fix_F_eq at h₂,
    simp at h₂,
    cases h₂ with h₂ h₃,
    cases e : (f a).get h₂ with b' a'; simp [e] at h₃,
    { subst b', refine or.inl ⟨h₂, e⟩ },
    { exact or.inr ⟨a', ⟨_, e⟩, part.mem_assert _ h₃⟩ }
  end,
λ h, begin
  simp [fix],
  rcases h with ⟨h₁, h₂⟩ | ⟨a', h, h₃⟩,
  { refine ⟨⟨_, λ y h', _⟩, _⟩,
    { injection part.mem_unique ⟨h₁, h₂⟩ h' },
    { rw well_founded.fix_F_eq, simp [h₁, h₂] } },
  { simp [fix] at h₃, cases h₃ with h₃ h₄,
    refine ⟨⟨_, λ y h', _⟩, _⟩,
    { injection part.mem_unique h h' with e,
      exact e ▸ h₃ },
    { cases h with h₁ h₂,
      rw well_founded.fix_F_eq, simp [h₁, h₂, h₄] } }
end⟩

/-- A recursion principle for `pfun.fix`. -/
@[elab_as_eliminator] def fix_induction
  {f : α →. β ⊕ α} {b : β} {C : α → Sort*} {a : α} (h : b ∈ f.fix a)
  (H : ∀ a, b ∈ f.fix a →
    (∀ a', b ∈ f.fix a' → sum.inr a' ∈ f a → C a') → C a) : C a :=
begin
  replace h := part.mem_assert_iff.1 h,
  have := h.snd, revert this,
  induction h.fst with a ha IH, intro h₂,
  refine H a (part.mem_assert_iff.2 ⟨⟨_, ha⟩, h₂⟩)
    (λ a' ha' fa', _),
  have := (part.mem_assert_iff.1 ha').snd,
  exact IH _ fa' ⟨ha _ fa', this⟩ this
end

end pfun

namespace pfun

variables {α β : Type*} (f : α →. β)

/-- Image of a set under a partial function. -/
def image (s : set α) : set β := f.graph'.image s

lemma image_def (s : set α) : f.image s = {y | ∃ x ∈ s, y ∈ f x} := rfl

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

lemma image_mono {s t : set α} (h : s ⊆ t) : f.image s ⊆ f.image t :=
rel.image_mono _ h

lemma image_inter (s t : set α) : f.image (s ∩ t) ⊆ f.image s ∩ f.image t :=
rel.image_inter _ s t

lemma image_union (s t : set α) : f.image (s ∪ t) = f.image s ∪ f.image t :=
rel.image_union _ s t

/-- Preimage of a set under a partial function. -/
def preimage (s : set β) : set α := rel.image (λ x y, x ∈ f y) s

lemma preimage_def (s : set β) : f.preimage s = {x | ∃ y ∈ s, y ∈ f x} := rfl

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

lemma preimage_subset_dom (s : set β) : f.preimage s ⊆ f.dom :=
λ x ⟨y, ys, fxy⟩, part.dom_iff_mem.mpr ⟨y, fxy⟩

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

lemma preimage_inter (s t : set β) : f.preimage (s ∩ t) ⊆ f.preimage s ∩ f.preimage t :=
rel.preimage_inter _ s t

lemma preimage_union (s t : set β) : f.preimage (s ∪ t) = f.preimage s ∪ f.preimage t :=
rel.preimage_union _ s t

lemma preimage_univ : f.preimage set.univ = f.dom :=
by ext; simp [mem_preimage, mem_dom]

/-- Core of a set `s : set β` with respect to a partial function `f : α →. β`. Set of all `a : α`
such that `f a ∈ s`, if `f a` is defined. -/
def core (s : set β) : set α := f.graph'.core s

lemma core_def (s : set β) : f.core s = {x | ∀ y, y ∈ f x → y ∈ s} := rfl

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

lemma compl_dom_subset_core (s : set β) : f.domᶜ ⊆ f.core s :=
λ x hx y fxy,
absurd ((mem_dom f x).mpr ⟨y, fxy⟩) hx

lemma core_mono {s t : set β} (h : s ⊆ t) : f.core s ⊆ f.core t :=
rel.core_mono _ h

lemma core_inter (s t : set β) : f.core (s ∩ t) = f.core s ∩ f.core t :=
rel.core_inter _ s t

lemma mem_core_res (f : α → β) (s : set α) (t : set β) (x : α) :
  x ∈ (res f s).core t ↔ x ∈ s → f x ∈ t :=
by simp [mem_core, mem_res]

section
open_locale classical

lemma core_res (f : α → β) (s : set α) (t : set β) : (res f s).core t = sᶜ ∪ f ⁻¹' t :=
by { ext, rw mem_core_res, by_cases h : x ∈ s; simp [h] }

end

lemma core_restrict (f : α → β) (s : set β) : (f : α →. β).core s = s.preimage f :=
by ext x; simp [core_def]

lemma preimage_subset_core (f : α →. β) (s : set β) : f.preimage s ⊆ f.core s :=
λ x ⟨y, ys, fxy⟩ y' fxy',
have y = y', from part.mem_unique fxy fxy',
this ▸ ys

lemma preimage_eq (f : α →. β) (s : set β) : f.preimage s = f.core s ∩ f.dom :=
set.eq_of_subset_of_subset
  (set.subset_inter (f.preimage_subset_core s) (f.preimage_subset_dom s))
  (λ x ⟨xcore, xdom⟩,
    let y := (f x).get xdom in
    have ys : y ∈ s, from xcore _ (part.get_mem _),
    show x ∈ f.preimage s, from  ⟨(f x).get xdom, ys, part.get_mem _⟩)

lemma core_eq (f : α →. β) (s : set β) : f.core s = f.preimage s ∪ f.domᶜ :=
by rw [preimage_eq, set.union_distrib_right, set.union_comm (dom f), set.compl_union_self,
        set.inter_univ, set.union_eq_self_of_subset_right (f.compl_dom_subset_core s)]

lemma preimage_as_subtype (f : α →. β) (s : set β) :
  f.as_subtype ⁻¹' s = subtype.val ⁻¹' f.preimage s :=
begin
  ext x,
  simp only [set.mem_preimage, set.mem_set_of_eq, pfun.as_subtype, pfun.mem_preimage],
  show f.fn (x.val) _ ∈ s ↔ ∃ y ∈ s, y ∈ f (x.val),
  exact iff.intro
    (λ h, ⟨_, h, part.get_mem _⟩)
    (λ ⟨y, ys, fxy⟩,
      have f.fn x.val x.property ∈ f x.val := part.get_mem _,
      part.mem_unique fxy this ▸ ys)
end

end pfun


import vorspiel

universes u v

namespace nat

section
variables {C : nat → Sort u}

def binary_recursion
  (z : C 0)
  (f₀ : ∀ n, n ≠ 0 → C n → C (bit0 n))
  (f₁ : ∀ n, C n → C (bit1 n)) : Π n, C n :=
binary_rec z
  (λ b, bool.cases_on b (λ n IH, if hn : n = 0 then by convert z; simp[nat.bit_ff, hn] else f₀ n hn IH) f₁)

variables {z : C 0}
  {f₀ : ∀ n, n ≠ 0 → C n → C (bit0 n)}
  {f₁ : ∀ n, C n → C (bit1 n)}

@[simp] lemma binary_recursion_zero_eq : binary_recursion z f₀ f₁ 0 = z := by simp[binary_recursion]

@[simp] lemma binary_recursion_bit1_eq (n) : binary_recursion z f₀ f₁ (bit1 n) = f₁ n (binary_recursion z f₀ f₁ n) :=
binary_rec_eq' tt n (by simp)

lemma binary_recursion_bit0_eq {n} (h : n ≠ 0) : binary_recursion z f₀ f₁ (bit0 n) = f₀ n h (binary_recursion z f₀ f₁ n) :=
begin
  rw [binary_recursion, binary_rec],
  have : bit0 n ≠ 0, from nat.bit0_ne_zero h,
  simp[this, h],
  generalize_proofs e, revert e,
  rw [bodd_bit0, div2_bit0], simp[h]
end

end

section
variables {C : nat → Sort u}

def binary_recursion_nonzero_aux
  (i : C 1)
  (f : ∀ b n, n ≠ 0 → C n → C (bit b n)) : Π b n, (n ≠ 0 → C n) → bit b n ≠ 0 → C (bit b n) :=
  (λ b n IH,
    if hn : n = 0 then
      bool.cases_on b
        (λ nonzero, by simp[bit, hn] at nonzero; contradiction)
        (λ _, by simpa[hn] using i)
    else (λ _, f b n hn (IH hn)))

def binary_recursion_nonzero
  (i : C 1)
  (f : ∀ b n, n ≠ 0 → C n → C (bit b n)) : Π n, n ≠ 0 → C n :=
binary_rec (λ A, by contradiction) (binary_recursion_nonzero_aux i f)

variables {i : C 1} {f : ∀ b n, n ≠ 0 → C n → C (bit b n)}

@[simp] lemma binary_recursion_nonzero_one_eq {h} : binary_recursion_nonzero i f 1 h = i :=
begin
  have : binary_recursion_nonzero i f 1 = λ _, i,
  { have : binary_recursion_nonzero i f 1 = binary_recursion_nonzero_aux i f tt 0 (λ A, by contradiction),
    from binary_rec_eq (by simp; refl) tt 0,
    simpa[binary_recursion_nonzero_aux] using this },
  exact congr_fun this h
end

lemma binary_recursion_nonzero_rec_eq {n} (hn : n ≠ 0) (b) {h} :
  binary_recursion_nonzero i f (bit b n) h = f b n hn (binary_recursion_nonzero i f n hn) :=
begin
  have : binary_recursion_nonzero i f (bit b n) = λ _, f b n hn (binary_recursion_nonzero i f n hn),
  { have : binary_recursion_nonzero i f (bit b n) = binary_recursion_nonzero_aux i f b n (binary_recursion_nonzero i f n),
    from binary_rec_eq (by refl) b n,
    simpa[binary_recursion_nonzero_aux, hn] using this },
  exact congr_fun this h
end
end

end nat

open nat

def Log : ℕ → ℕ := binary_rec 0 (λ_ _, succ)

@[simp] lemma Log_zero : Log 0 = 0 := by simp[Log]

lemma Log_bit {b} {n} (h : bit b n ≠ 0) : Log (bit b n) = Log n + 1 :=
nat.binary_rec_eq' b n (by { simp, rintros rfl, rcases b; simp at h, contradiction })

lemma div2_Log {n} (h : n ≠ 0) : Log n = Log n.div2 + 1 :=
calc
  Log n = Log (bit n.bodd n.div2) : by simp
    ... = Log n.div2 + 1          : by rw Log_bit; simp[h]

lemma Log_two_mul {n} (h : n ≠ 0) : Log (2 * n) = Log n + 1 :=
by { rw @div2_Log (2 * n) (by simpa using h), simp[nat.div2_val] }

@[simp] lemma Log_one : Log 1 = 1 := by simp[div2_Log]

@[simp] lemma Log_two : Log 2 = 2 := by simp[div2_Log]

lemma Log_eq_log : ∀ {n}, n ≠ 0 → Log n = log 2 n + 1 :=
binary_rec (by simp)
(λ b n h ne_zero, by {
  suffices : Log n = log 2 (bit b n), by simpa[Log_bit ne_zero] using this,
  by_cases hn : n = 0,
  { have : b = tt, by rcases b; simp[hn] at ne_zero; contradiction,
    simp[hn, this, nat.bit_tt] },
  { calc
      Log n = log 2 n + 1
    : h hn
        ... = log 2 (bit b n / 2) + 1
    : by rw (show bit b n / 2 = n, by simpa[nat.div2_val] using div2_bit b n)
        ... = log 2 (bit b n)
    : by symmetry; refine nat.log_of_one_lt_of_le (by simp) (by rcases b; simp[bit, one_le_iff_ne_zero.mpr hn]) } })

lemma Log_monotone : monotone Log :=
λ n m h, by { by_cases hm : m = 0,
  { have : n = 0, by simpa[hm] using h, simp[this] },
  { by_cases hn : n = 0,
    { simp[hn] },
    { simp[Log_eq_log, hn, hm], exact log_monotone h } } }

lemma linear_le_pow_Log : ∀ n, n + 1 ≤ 2^Log n :=
binary_rec (by simp)
  (λ b n IH, by {
    by_cases C : bit b n = 0,
    { simp[C] },
    { calc
        bit b n + 1 ≤ 2 * (n + 1)     : by rcases b; simp[mul_add, nat.bit_val, add_assoc]
                ... ≤ 2* (2^Log n)    : by simpa using IH
                ... ≤ 2^Log (bit b n) : by simp[Log_bit C, pow_add, mul_comm] } })

lemma pow_Log_le_linear : ∀ {n}, n ≠ 0 → 2^Log n ≤ 2 * n :=
binary_recursion_nonzero (by simp)
  (λ b n nonzero IH, by {
    have : bit b n ≠ 0, by simp[bit_eq_zero_iff, nonzero],
    calc
        2^Log (bit b n) ≤ 2 * 2^Log n : by simp[Log_bit this, pow_add, mul_comm]
                    ... ≤ 2 * (2 * n) : by simpa using IH
                    ... ≤ 2 * bit b n : by simp[bit_val] })

@[simp] lemma pow_Log_le_linear' (n) : 2^Log n ≤ 2 * n + 1 :=
by { by_cases n = 0, { simp[h] }, { exact le_add_right (pow_Log_le_linear h)} }

@[simp] lemma Log_le_linear : ∀ n, Log n ≤ n :=
binary_rec (by simp)
(λ b n IH, by { by_cases h : bit b n = 0,
  { simp[h] },
  { calc
      Log (bit b n) = Log n + 1 : Log_bit h
                ... ≤ n + 1     : by simp[IH]
                ... ≤ bit b n
      : by { rcases b; simp[bit_ff, bit_tt, two_mul] at h ⊢, { exact one_le_iff_ne_zero.mpr h } } } })

@[simp] lemma Log_pow (n) : Log (2^n) = n + 1 :=
by { induction n with n IH, { simp },
     { have : 2 ^ n ≠ 0, by { exact ne_zero.ne (2 ^ n) },
      simp[pow_succ, Log_two_mul this, IH] } }

lemma Log_pow_le_linear_aux {k : ℕ} (hk : k ≠ 0) :
  ∀ {n}, n ≠ 0 → k.pow_le_two_mul_pow_of_le_bound ≤ Log n → (Log n)^k ≤ (k.pow_le_two_mul_pow_of_le_bound + 1)^k * n :=
binary_recursion_nonzero (λ h, by { simp; refine nat.one_le_pow _ _ (by simp) })
  (λ b n nonzero IH hn, by {
    by_cases C₁ : bit b n = 0,
    { simp[C₁, hk], },
    have : Log n ≤ k.pow_le_two_mul_pow_of_le_bound ∨ k.pow_le_two_mul_pow_of_le_bound ≤ Log n, from le_total _ _,
    rcases this with (le|le),
    { calc
        Log (bit b n)^k = (Log n + 1)^k                                      : by rw[Log_bit C₁]
                    ... ≤ (k.pow_le_two_mul_pow_of_le_bound + 1)^k           : pow_le_pow_of_le_left (by simp) (by simpa using le) _
                    ... ≤ (k.pow_le_two_mul_pow_of_le_bound + 1)^k * bit b n : nat.le_mul_of_pos_right (zero_lt_iff.mpr C₁) },
    { calc
        Log (bit b n)^k = (Log n + 1)^k                                      : by rw[Log_bit C₁]
                    ... ≤ 2 * (Log n)^k                                      : pow_le_two_mul_pow_of_le hk le
                    ... ≤ 2 * (k.pow_le_two_mul_pow_of_le_bound + 1)^k * n   : by simpa[mul_assoc] using IH le
                    ... ≤ (k.pow_le_two_mul_pow_of_le_bound + 1)^k * bit b n : by rw[mul_comm 2]; simp[mul_assoc, bit_val] } })

lemma Log_pow_le_linear (k : ℕ) :
  ∀ n ≥ 2^k.pow_le_two_mul_pow_of_le_bound, (Log n)^k ≤ (k.pow_le_two_mul_pow_of_le_bound + 1)^k * n :=
begin
  by_cases C₁ : k = 0,
  { intros n hn, simp[C₁], refine le_trans (one_le_pow' _ 1) hn  },
  { intros n hn,
    by_cases C₂ : n = 0,
    { simp[C₂], exact zero_lt_iff.mpr C₁ },
    { exact Log_pow_le_linear_aux C₁ C₂ (le_of_succ_le (by simpa using Log_monotone hn)) } }
end


import M4R.Set.Defs
import M4R.Numbers

namespace M4R
  namespace Set

    protected theorem elementExt {s : Set α} : ∀ {a b : ↑s}, a.val = b.val → a = b
    | ⟨_, _⟩, ⟨_, _⟩, heq => by rw [Subtype.mk.injEq]; exact heq

    /- Set instances -/
    def SetInhabited : Inhabited (Set α) where default := Set.Empty
    protected def singleton {α : Type _} (a : α) : Set α := {x | x = a}
    protected theorem singleton.mem {α : Type _} (a : α) : ∀ x, x ∈ Set.singleton a ↔ x = a := fun _ => Iff.rfl

    theorem empty_subset (s : Set α) : ∅ ⊆ s := fun _ _ => by contradiction
    theorem not_mem_empty (a : α) : a ∉ (∅ : Set α) := id

    namespace equivalent

      protected theorem refl (s : Set α) : Set.equivalent s s := by
        intro _; exact Iff.rfl
      protected theorem symm {s₁ s₂ : Set α} : Set.equivalent s₁ s₂ → Set.equivalent s₂ s₁ := by
        intro heq a; exact Iff.symm (heq a)
      protected theorem trans {s₁ s₂ s₃ : Set α} : Set.equivalent s₁ s₂ → Set.equivalent s₂ s₃ → Set.equivalent s₁ s₃ := by
        intro h12 h23 a; exact Iff.trans (h12 a) (h23 a)

      instance SetEquivalence : Equivalence (@Set.equivalent α) where
        refl := equivalent.refl
        symm := equivalent.symm
        trans := equivalent.trans

    end equivalent

    protected theorem ext {s₁ s₂ : Set α} : Set.equivalent s₁ s₂ ↔ s₁ = s₂ :=
      ⟨fun hiff => funext fun a => propext (hiff a), fun heq _ => heq ▸ Iff.rfl⟩

    protected theorem singleton.ext {s : Set α} {a : α} : s = Set.singleton a ↔ ∀ x, x ∈ s ↔ x = a :=
      Set.ext.symm.trans Iff.rfl

    protected theorem empty {s : Set α} : s = ∅ ↔ ∀ x, x ∉ s := by
      simp only [←Set.ext, Set.equivalent, not_mem_empty, iff_false]; exact Iff.rfl

    protected theorem nonempty {s : Set α} : s ≠ ∅ ↔ Nonempty s :=
      ⟨fun h =>
        have : ∃ x, x ∈ s := Classical.byContradiction fun hn =>
          h (Set.ext.mp fun x =>
            ⟨fun xs => hn ⟨x, xs⟩, by intros; contradiction⟩)
        Nonempty.intro (Classical.indefiniteDescription s this),
      fun h₁ h₂ => by
        have ⟨x, xs⟩ := Classical.choice h₁
        rw [h₂] at xs
        contradiction⟩

    namespace subset

      protected theorem refl (s : Set α) : s ⊆ s := by
        intro _ as; exact as

      protected theorem antisymmIff {a b : Set α} : a = b ↔ a ⊆ b ∧ b ⊆ a := by
        rw [Subset.antisymm a b, ←Set.ext]; exact Iff.rfl

      protected theorem antisymm {a b : Set α} (hab : a ⊆ b) (hba : b ⊆ a) : a = b :=
        Set.subset.antisymmIff.mpr ⟨hab, hba⟩

      theorem subUniversal (s : Set α) : s ⊆ Set.Universal := by
        intro _ _; trivial

      theorem proper_neq {a b : Set α} : a ⊊ b → a ≠ b :=
        fun ⟨_, x, nxa, xb⟩ ab => nxa ((Set.ext.mpr ab x).mpr xb)

      theorem neq_proper {a b : Set α} : a ⊆ b → a ≠ b → a ⊊ b :=
        fun h₁ h₂ => ⟨h₁, Classical.byContradiction fun h' => by
            have := not_exists.mp h'
            simp only [not_and_iff_or_not, iff_not_not] at this
            apply h₂; apply Set.ext.mp fun x => ⟨@h₁ x, (this x).neg_resolve_right⟩⟩

      protected theorem insert (s : Set α) (a : α) : s ⊆ s.insert a :=
        fun _ => Or.inr

      protected theorem insert_neq {s : Set α} {a : α} (h : a ∉ s) : s ⊊ s.insert a :=
        ⟨subset.insert s a, ⟨a, h, Or.inl rfl⟩⟩

      protected theorem proper_iff {a b : Set α} : a ⊊ b ↔ a ⊆ b ∧ a ≠ b :=
        ⟨fun h => ⟨h.left, proper_neq h⟩, fun ⟨h₁, h₂⟩ => neq_proper h₁ h₂⟩

      protected theorem not_proper {a b : Set α} : ¬a ⊊ b ↔ a ⊈ b ∨ a = b := by
        rw [subset.proper_iff, not_and_iff_or_not, iff_not_not]; exact Iff.rfl

    end subset

    namespace union

      protected theorem comm (s₁ s₂ : Set α) : s₁ ∪ s₂ = s₂ ∪ s₁ := by
        have : ∀ (t₁ t₂ : Set α), t₁ ∪ t₂ ⊆ t₂ ∪ t₁ := fun _ _ _ => Or.comm
        exact Set.subset.antisymm (this s₁ s₂) (this s₂ s₁)

      protected theorem subset {s₁ s₂ s₃ : Set α} (h₁ : s₁ ⊆ s₃) (h₂ : s₂ ⊆ s₃) : s₁ ∪ s₂ ⊆ s₃ :=
        fun x => (Or.elim · (@h₁ x) (@h₂ x))

      protected theorem subset_union_left (s₁ s₂ : Set α) : s₁ ⊆ s₁ ∪ s₂ := fun _ => Or.inl

      protected theorem subset_union_right (s₁ s₂ : Set α) : s₂ ⊆ s₁ ∪ s₂ := fun _ => Or.inr

    end union

    namespace intersection

      protected theorem comm (s₁ s₂ : Set α) : s₁ ∩ s₂ = s₂ ∩ s₁ := by
        have : ∀ (t₁ t₂ : Set α), t₁ ∩ t₂ ⊆ t₂ ∩ t₁ :=  fun _ _ _ => And.comm
        exact Set.subset.antisymm (this s₁ s₂) (this s₂ s₁)

      theorem inter_eq_self_of_subset_left {s t : Set α} (h : s ⊆ t) : s ∩ t = s :=
        Set.ext.mp fun _ => ⟨And.left, fun h' => ⟨h', h h'⟩⟩

      theorem inter_eq_self_of_subset_right {s t : Set α} (h : t ⊆ s) : s ∩ t = t := by
        apply Set.ext.mp fun x => ⟨And.right, fun h' => ⟨h h', h'⟩⟩

      theorem subset_inter_left (s t : Set α) : s ∩ t ⊆ s := fun _ => And.left
      theorem subset_inter_right (s t : Set α) : s ∩ t ⊆ t := fun _ => And.right
      theorem and_subset_and {s₁ s₂ t₁ t₂ : Set α} (hs : s₁ ⊆ s₂) (ht : t₁ ⊆ t₂) : s₁ ∩ t₁ ⊆ s₂ ∩ t₂ :=
        fun _ => And.imp (hs ·) (ht ·)

    end intersection

    namespace minus

      theorem nonempty {s₁ s₂ : Set α} (h : s₁ ⊊ s₂) : Nonempty ↑(s₂ ∖ s₁) :=
        let ⟨x, nxs₁, xs₂⟩ := h.right
        ⟨x, xs₂, nxs₁⟩

      theorem proper {s₁ s₂ : Set α} (h₁ : s₁ ⊆ s₂) (h₂ : Nonempty ↑(s₂ ∖ s₁)) : s₁ ⊊ s₂ :=
        ⟨h₁, let ⟨x, xs₂, nxs₁⟩ := Classical.choice h₂
          ⟨x, nxs₁, xs₂⟩⟩

    end minus

    namespace complement

      theorem comp_comp (s : Set α) : sᶜᶜ = s :=
        Set.ext.mp (fun  x => iff_not_not)

    end complement

    namespace disjoint

      protected theorem comm {s₁ s₂ : Set α} : disjoint s₁ s₂ → disjoint s₂ s₁ := by
          intro dis; simp only [disjoint]; rw [←dis]; exact Set.intersection.comm _ _

      protected theorem comm' {s₁ s₂ : Set α} : disjoint s₁ s₂ ↔ disjoint s₂ s₁ :=
        ⟨disjoint.comm, disjoint.comm⟩

      theorem elementwise {s₁ s₂ : Set α} : disjoint s₁ s₂ ↔ ∀ a ∈ s₁, a ∉ s₂ := by
        apply Iff.intro
        { intro dis x xs₁ xs₂; have : x ∈ s₁ ∩ s₂ := ⟨xs₁, xs₂⟩; rw [dis] at this; contradiction }
        { exact fun h => Set.subset.antisymm (fun x xs => h x xs.left xs.right) (fun _ _ => by contradiction) }

      theorem not_disjoint_iff_nonempty {s₁ s₂ : Set α} : ¬disjoint s₁ s₂ ↔ Nonempty (s₁ ∩ s₂ : Set α) :=
        Set.nonempty

      theorem subset_left {s₁ s₂ s₃ : Set α} (h₁ : s₁ ⊆ s₂) (h₂ : disjoint s₂ s₃) : disjoint s₁ s₃ :=
        elementwise.mpr fun x hx => elementwise.mp h₂ x (h₁ hx)

    end disjoint

    namespace SoSUnion

      protected theorem subset {S : Set (Set α)} {t : Set α} (h : ∀ s ∈ S, s ⊆ t) : (⋃₀ S) ⊆ t :=
        fun _ ⟨s, sS, xs⟩ => h s sS xs

      protected theorem subset_of_mem {S : Set (Set α)} {t : Set α} (tS : t ∈ S) : t ⊆ ⋃₀ S :=
        fun _ xt => ⟨t, ⟨tS, xt⟩⟩

      protected theorem subset_iff {s : Set (Set α)} {t : Set α} : ⋃₀ s ⊆ t ↔ ∀t' ∈ s, t' ⊆ t :=
        ⟨fun h t' ht' => Subset.trans (SoSUnion.subset_of_mem ht') h, SoSUnion.subset⟩

      protected theorem mem {S : Set (Set α)} {a : α} : a ∈ ⋃₀ S ↔ ∃ s ∈ S, a ∈ s := Iff.rfl

    end SoSUnion

    namespace SoSIntersection

      protected theorem subset {S : Set (Set α)} {t : Set α} (h : ∀ s ∈ S, t ⊆ s) : t ⊆ (⋂₀ S) :=
        fun _ xt s sS => h s sS xt

      protected theorem subset_of_mem {S : Set (Set α)} {t : Set α} (tS : t ∈ S) : ⋂₀ S ⊆ t :=
        fun _ xIS => xIS t tS

      protected theorem subset_iff {S : Set (Set α)} {t : Set α} : t ⊆ ⋂₀ S ↔ ∀ t' ∈ S, t ⊆ t' :=
        ⟨fun h t' ht' => Subset.trans h (SoSIntersection.subset_of_mem ht'), SoSIntersection.subset⟩

      protected theorem mem {S : Set (Set α)} {a : α} : a ∈ ⋂₀ S ↔ ∀ s ∈ S, a ∈ s := Iff.rfl

      protected theorem single (S : Set α) : ⋂₀ Set.singleton S = S :=
        Set.ext.mp fun s => ⟨fun hs => hs S rfl, fun hs s' hs' => hs' ▸ hs⟩

    end SoSIntersection

  end Set
end M4R


-- Boilerplate:
import data.real.basic
namespace examples

/-
A basic example is the definition of the multiplication operator `*` in core Lean:
-/
-- Adapted from `library/init/core.lean:301`
class has_mul (α : Type*) := (mul : α → α → α)
infix * := has_mul.mul
/-
[T]he `has_inv` class providing `⁻¹` notation for the multiplicative inverse does not have any fields requiring a multiplicative group structure.
-/
#print has_inv

/-
Notation typeclasses are also used in Lean 3 to parse numerals into a little-endian binary representation.
For example, `(37 : ℝ) = 0b100101` is represented as:
-/
set_option pp.numerals false
#check (37 : ℝ)

/-
Whenever the elaborator encounters a term `t : A` that is instead expected to have type `B`,
it replaces `t` with `@coe A B _ t`,
where the `_` marks an instance parameter of type `has_lift_t A B`.-/
#print coe
#print has_coe_t
/-
Similarly, when a term `f : F` produces a type error because it is expected to have a dependent function type,
it is replaced with `coe_fn f` (where `coe_fn {F A} [has_coe_to_fun F A] : Π (f : F), A f`),
-/
#print coe_fn
#print has_coe_to_fun
/-
and when `t` is expected to be of the form `Sort u` (either `Type v` or `Prop`), it is replaced with `coe_sort t`
(where `coe_sort {A} [has_coe_to_sort A] : Sort u`).
-/
#print coe_sort
#print has_coe_to_sort

end examples