/-
Copyright (c) 2021 Yourong Zang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yourong Zang, Yury Kudryashov
-/
import topology.separation
import topology.sets.opens

/-!
# The Alexandroff Compactification

We construct the Alexandroff compactification (the one-point compactification) of an arbitrary
topological space `X` and prove some properties inherited from `X`.

## Main definitions

* `alexandroff`: the Alexandroff compactification, we use coercion for the canonical embedding
  `X → alexandroff X`; when `X` is already compact, the compactification adds an isolated point
  to the space.
* `alexandroff.infty`: the extra point

## Main results

* The topological structure of `alexandroff X`
* The connectedness of `alexandroff X` for a noncompact, preconnected `X`
* `alexandroff X` is `T₀` for a T₀ space `X`
* `alexandroff X` is `T₁` for a T₁ space `X`
* `alexandroff X` is normal if `X` is a locally compact Hausdorff space

## Tags

one-point compactification, compactness
-/

open set filter
open_locale classical topological_space filter

/-!
### Definition and basic properties

In this section we define `alexandroff X` to be the disjoint union of `X` and `∞`, implemented as
`option X`. Then we restate some lemmas about `option X` for `alexandroff X`.
-/

variables {X : Type*}

/-- The Alexandroff extension of an arbitrary topological space `X` -/
def alexandroff (X : Type*) := option X

/-- The repr uses the notation from the `alexandroff` locale. -/
instance [has_repr X] : has_repr (alexandroff X) :=
⟨λ o, match o with | none := "∞" | (some a) := "↑" ++ repr a end⟩

namespace alexandroff

/-- The point at infinity -/
def infty : alexandroff X := none
localized "notation `∞` := alexandroff.infty" in alexandroff

instance : has_coe_t X (alexandroff X) := ⟨option.some⟩

instance : inhabited (alexandroff X) := ⟨∞⟩

instance [fintype X] : fintype (alexandroff X) := option.fintype

instance infinite [infinite X] : infinite (alexandroff X) := option.infinite

lemma coe_injective : function.injective (coe : X → alexandroff X) :=
option.some_injective X

@[norm_cast] lemma coe_eq_coe {x y : X} : (x : alexandroff X) = y ↔ x = y :=
coe_injective.eq_iff

@[simp] lemma coe_ne_infty (x : X) : (x : alexandroff X) ≠ ∞  .
@[simp] lemma infty_ne_coe (x : X) : ∞ ≠ (x : alexandroff X) .

/-- Recursor for `alexandroff` using the preferred forms `∞` and `↑x`. -/
@[elab_as_eliminator]
protected def rec (C : alexandroff X → Sort*) (h₁ : C ∞) (h₂ : Π x : X, C x) :
  Π (z : alexandroff X), C z :=
option.rec h₁ h₂

@[simp] lemma range_coe_union_infty : (range (coe : X → alexandroff X) ∪ {∞}) = univ :=
range_some_union_none X

@[simp] lemma range_coe_inter_infty : (range (coe : X → alexandroff X) ∩ {∞}) = ∅ :=
range_some_inter_none X

@[simp] lemma compl_range_coe : (range (coe : X → alexandroff X))ᶜ = {∞} :=
compl_range_some X

lemma compl_infty : ({∞}ᶜ : set (alexandroff X)) = range (coe : X → alexandroff X) :=
(@is_compl_range_coe_infty X).symm.compl_eq

lemma compl_image_coe (s : set X) : (coe '' s : set (alexandroff X))ᶜ = coe '' sᶜ ∪ {∞} :=
by rw [coe_injective.compl_image_eq, compl_range_coe]

lemma ne_infty_iff_exists {x : alexandroff X} :
  x ≠ ∞ ↔ ∃ (y : X), (y : alexandroff X) = x :=
by induction x using alexandroff.rec; simp

instance : can_lift (alexandroff X) X :=
{ coe := coe,
  cond := λ x, x ≠ ∞,
  prf := λ x, ne_infty_iff_exists.1 }

lemma not_mem_range_coe_iff {x : alexandroff X} :
  x ∉ range (coe : X → alexandroff X) ↔ x = ∞ :=
by rw [← mem_compl_iff, compl_range_coe, mem_singleton_iff]

lemma infty_not_mem_range_coe : ∞ ∉ range (coe : X → alexandroff X) :=
not_mem_range_coe_iff.2 rfl

lemma infty_not_mem_image_coe {s : set X} : ∞ ∉ (coe : X → alexandroff X) '' s :=
not_mem_subset (image_subset_range _ _) infty_not_mem_range_coe

@[simp] lemma coe_preimage_infty : (coe : X → alexandroff X) ⁻¹' {∞} = ∅ :=
by { ext, simp }

/-!
### Topological space structure on `alexandroff X`

We define a topological space structure on `alexandroff X` so that `s` is open if and only if

* `coe ⁻¹' s` is open in `X`;
* if `∞ ∈ s`, then `(coe ⁻¹' s)ᶜ` is compact.

Then we reformulate this definition in a few different ways, and prove that
`coe : X → alexandroff X` is an open embedding. If `X` is not a compact space, then we also prove
that `coe` has dense range, so it is a dense embedding.
-/

variables [topological_space X]

instance : topological_space (alexandroff X) :=
{ is_open := λ s, (∞ ∈ s → is_compact ((coe : X → alexandroff X) ⁻¹' s)ᶜ) ∧
    is_open ((coe : X → alexandroff X) ⁻¹' s),
  is_open_univ := by simp,
  is_open_inter := λ s t,
  begin
    rintros ⟨hms, hs⟩ ⟨hmt, ht⟩,
    refine ⟨_, hs.inter ht⟩,
    rintros ⟨hms', hmt'⟩,
    simpa [compl_inter] using (hms hms').union (hmt hmt')
  end,
  is_open_sUnion := λ S ho,
  begin
    suffices : is_open (coe ⁻¹' ⋃₀ S : set X),
    { refine ⟨_, this⟩,
      rintro ⟨s, hsS : s ∈ S, hs : ∞ ∈ s⟩,
      refine compact_of_is_closed_subset ((ho s hsS).1 hs) this.is_closed_compl _,
      exact compl_subset_compl.mpr (preimage_mono $ subset_sUnion_of_mem hsS) },
    rw [preimage_sUnion],
    exact is_open_bUnion (λ s hs, (ho s hs).2)
  end }

variables {s : set (alexandroff X)} {t : set X}

lemma is_open_def :
  is_open s ↔ (∞ ∈ s → is_compact (coe ⁻¹' s : set X)ᶜ) ∧ is_open (coe ⁻¹' s : set X) :=
iff.rfl

lemma is_open_iff_of_mem' (h : ∞ ∈ s) :
  is_open s ↔ is_compact (coe ⁻¹' s : set X)ᶜ ∧ is_open (coe ⁻¹' s : set X) :=
by simp [is_open_def, h]

lemma is_open_iff_of_mem (h : ∞ ∈ s) :
  is_open s ↔ is_closed (coe ⁻¹' s : set X)ᶜ ∧ is_compact (coe ⁻¹' s : set X)ᶜ :=
by simp only [is_open_iff_of_mem' h, is_closed_compl_iff, and.comm]

lemma is_open_iff_of_not_mem (h : ∞ ∉ s) :
  is_open s ↔ is_open (coe ⁻¹' s : set X) :=
by simp [is_open_def, h]

lemma is_closed_iff_of_mem (h : ∞ ∈ s) :
  is_closed s ↔ is_closed (coe ⁻¹' s : set X) :=
have ∞ ∉ sᶜ, from λ H, H h,
by rw [← is_open_compl_iff, is_open_iff_of_not_mem this, ← is_open_compl_iff, preimage_compl]

lemma is_closed_iff_of_not_mem (h : ∞ ∉ s) :
  is_closed s ↔ is_closed (coe ⁻¹' s : set X) ∧ is_compact (coe ⁻¹' s : set X) :=
by rw [← is_open_compl_iff, is_open_iff_of_mem (mem_compl h), ← preimage_compl, compl_compl]

@[simp] lemma is_open_image_coe {s : set X} :
  is_open (coe '' s : set (alexandroff X)) ↔ is_open s :=
by rw [is_open_iff_of_not_mem infty_not_mem_image_coe, preimage_image_eq _ coe_injective]

lemma is_open_compl_image_coe {s : set X} :
  is_open (coe '' s : set (alexandroff X))ᶜ ↔ is_closed s ∧ is_compact s :=
begin
  rw [is_open_iff_of_mem, ← preimage_compl, compl_compl, preimage_image_eq _ coe_injective],
  exact infty_not_mem_image_coe
end

@[simp] lemma is_closed_image_coe {s : set X} :
  is_closed (coe '' s : set (alexandroff X)) ↔ is_closed s ∧ is_compact s :=
by rw [← is_open_compl_iff, is_open_compl_image_coe]

/-- An open set in `alexandroff X` constructed from a closed compact set in `X` -/
def opens_of_compl (s : set X) (h₁ : is_closed s) (h₂ : is_compact s) :
  topological_space.opens (alexandroff X) :=
⟨(coe '' s)ᶜ, is_open_compl_image_coe.2 ⟨h₁, h₂⟩⟩

lemma infty_mem_opens_of_compl {s : set X} (h₁ : is_closed s) (h₂ : is_compact s) :
  ∞ ∈ opens_of_compl s h₁ h₂ :=
mem_compl infty_not_mem_image_coe

@[continuity] lemma continuous_coe : continuous (coe : X → alexandroff X) :=
continuous_def.mpr (λ s hs, hs.right)

lemma is_open_map_coe  : is_open_map (coe : X → alexandroff X) :=
λ s, is_open_image_coe.2

lemma open_embedding_coe : open_embedding (coe : X → alexandroff X) :=
open_embedding_of_continuous_injective_open continuous_coe coe_injective is_open_map_coe

lemma is_open_range_coe : is_open (range (coe : X → alexandroff X)) :=
open_embedding_coe.open_range

lemma is_closed_infty : is_closed ({∞} : set (alexandroff X)) :=
by { rw [← compl_range_coe, is_closed_compl_iff], exact is_open_range_coe }

lemma nhds_coe_eq (x : X) : 𝓝 ↑x = map (coe : X → alexandroff X) (𝓝 x) :=
(open_embedding_coe.map_nhds_eq x).symm

lemma nhds_within_coe_image (s : set X) (x : X) :
  𝓝[coe '' s] (x : alexandroff X) = map coe (𝓝[s] x) :=
(open_embedding_coe.to_embedding.map_nhds_within_eq _ _).symm

lemma nhds_within_coe (s : set (alexandroff X)) (x : X) :
  𝓝[s] ↑x = map coe (𝓝[coe ⁻¹' s] x) :=
(open_embedding_coe.map_nhds_within_preimage_eq _ _).symm

lemma comap_coe_nhds (x : X) : comap (coe : X → alexandroff X) (𝓝 x) = 𝓝 x :=
(open_embedding_coe.to_inducing.nhds_eq_comap x).symm

/-- If `x` is not an isolated point of `X`, then `x : alexandroff X` is not an isolated point
of `alexandroff X`. -/
instance nhds_within_compl_coe_ne_bot (x : X) [h : ne_bot (𝓝[≠] x)] :
  ne_bot (𝓝[≠] (x : alexandroff X)) :=
by simpa [nhds_within_coe, preimage, coe_eq_coe] using h.map coe

lemma nhds_within_compl_infty_eq : 𝓝[≠] (∞ : alexandroff X) = map coe (coclosed_compact X) :=
begin
  refine (nhds_within_basis_open ∞ _).ext (has_basis_coclosed_compact.map _) _ _,
  { rintro s ⟨hs, hso⟩,
    refine ⟨_, (is_open_iff_of_mem hs).mp hso, _⟩,
    simp },
  { rintro s ⟨h₁, h₂⟩,
    refine ⟨_, ⟨mem_compl infty_not_mem_image_coe, is_open_compl_image_coe.2 ⟨h₁, h₂⟩⟩, _⟩,
    simp [compl_image_coe, ← diff_eq, subset_preimage_image] }
end

/-- If `X` is a non-compact space, then `∞` is not an isolated point of `alexandroff X`. -/
instance nhds_within_compl_infty_ne_bot [noncompact_space X] :
  ne_bot (𝓝[≠] (∞ : alexandroff X)) :=
by { rw nhds_within_compl_infty_eq, apply_instance }

@[priority 900]
instance nhds_within_compl_ne_bot [∀ x : X, ne_bot (𝓝[≠] x)] [noncompact_space X]
  (x : alexandroff X) : ne_bot (𝓝[≠] x) :=
alexandroff.rec _ alexandroff.nhds_within_compl_infty_ne_bot
  (λ y, alexandroff.nhds_within_compl_coe_ne_bot y) x

lemma nhds_infty_eq : 𝓝 (∞ : alexandroff X) = map coe (coclosed_compact X) ⊔ pure ∞ :=
by rw [← nhds_within_compl_infty_eq, nhds_within_compl_singleton_sup_pure]

lemma has_basis_nhds_infty :
  (𝓝 (∞ : alexandroff X)).has_basis (λ s : set X, is_closed s ∧ is_compact s)
    (λ s, coe '' sᶜ ∪ {∞}) :=
begin
  rw nhds_infty_eq,
  exact (has_basis_coclosed_compact.map _).sup_pure _
end

@[simp] lemma comap_coe_nhds_infty : comap (coe : X → alexandroff X) (𝓝 ∞) = coclosed_compact X :=
by simp [nhds_infty_eq, comap_sup, comap_map coe_injective]

lemma le_nhds_infty {f : filter (alexandroff X)} :
  f ≤ 𝓝 ∞ ↔ ∀ s : set X, is_closed s → is_compact s → coe '' sᶜ ∪ {∞} ∈ f :=
by simp only [has_basis_nhds_infty.ge_iff, and_imp]

lemma ultrafilter_le_nhds_infty {f : ultrafilter (alexandroff X)} :
  (f : filter (alexandroff X)) ≤ 𝓝 ∞ ↔ ∀ s : set X, is_closed s → is_compact s → coe '' s ∉ f :=
by simp only [le_nhds_infty, ← compl_image_coe, ultrafilter.mem_coe,
  ultrafilter.compl_mem_iff_not_mem]

lemma tendsto_nhds_infty' {α : Type*} {f : alexandroff X → α} {l : filter α} :
  tendsto f (𝓝 ∞) l ↔ tendsto f (pure ∞) l ∧ tendsto (f ∘ coe) (coclosed_compact X) l :=
by simp [nhds_infty_eq, and_comm]

lemma tendsto_nhds_infty {α : Type*} {f : alexandroff X → α} {l : filter α} :
  tendsto f (𝓝 ∞) l ↔
    ∀ s ∈ l, f ∞ ∈ s ∧ ∃ t : set X, is_closed t ∧ is_compact t ∧ maps_to (f ∘ coe) tᶜ s :=
tendsto_nhds_infty'.trans $ by simp only [tendsto_pure_left,
  has_basis_coclosed_compact.tendsto_left_iff, forall_and_distrib, and_assoc, exists_prop]

lemma continuous_at_infty' {Y : Type*} [topological_space Y] {f : alexandroff X → Y} :
  continuous_at f ∞ ↔ tendsto (f ∘ coe) (coclosed_compact X) (𝓝 (f ∞)) :=
tendsto_nhds_infty'.trans $ and_iff_right (tendsto_pure_nhds _ _)

lemma continuous_at_infty {Y : Type*} [topological_space Y] {f : alexandroff X → Y} :
  continuous_at f ∞ ↔
    ∀ s ∈ 𝓝 (f ∞), ∃ t : set X, is_closed t ∧ is_compact t ∧ maps_to (f ∘ coe) tᶜ s :=
continuous_at_infty'.trans $
  by simp only [has_basis_coclosed_compact.tendsto_left_iff, exists_prop, and_assoc]

lemma continuous_at_coe {Y : Type*} [topological_space Y] {f : alexandroff X → Y} {x : X} :
  continuous_at f x ↔ continuous_at (f ∘ coe) x :=
by rw [continuous_at, nhds_coe_eq, tendsto_map'_iff, continuous_at]

/-- If `X` is not a compact space, then the natural embedding `X → alexandroff X` has dense range.
-/
lemma dense_range_coe [noncompact_space X] :
  dense_range (coe : X → alexandroff X) :=
begin
  rw [dense_range, ← compl_infty],
  exact dense_compl_singleton _
end

lemma dense_embedding_coe [noncompact_space X] :
  dense_embedding (coe : X → alexandroff X) :=
{ dense := dense_range_coe, .. open_embedding_coe }

/-!
### Compactness and separation properties

In this section we prove that `alexandroff X` is a compact space; it is a T₀ (resp., T₁) space if
the original space satisfies the same separation axiom. If the original space is a locally compact
Hausdorff space, then `alexandroff X` is a normal (hence, regular and Hausdorff) space.

Finally, if the original space `X` is *not* compact and is a preconnected space, then
`alexandroff X` is a connected space.
-/

/-- For any topological space `X`, its one point compactification is a compact space. -/
instance : compact_space (alexandroff X) :=
{ compact_univ :=
  begin
    have : tendsto (coe : X → alexandroff X) (cocompact X) (𝓝 ∞),
    { rw [nhds_infty_eq],
      exact (tendsto_map.mono_left cocompact_le_coclosed_compact).mono_right le_sup_left },
    convert ← this.is_compact_insert_range_of_cocompact continuous_coe,
    exact insert_none_range_some X
  end }

/-- The one point compactification of a `t0_space` space is a `t0_space`. -/
instance [t0_space X] : t0_space (alexandroff X) :=
begin
  refine ⟨λ x y hxy, _⟩,
  induction x using alexandroff.rec; induction y using alexandroff.rec,
  { exact (hxy rfl).elim },
  { use {∞}ᶜ, simp [is_closed_infty] },
  { use {∞}ᶜ, simp [is_closed_infty] },
  { rcases t0_space.t0 x y (mt coe_eq_coe.mpr hxy) with ⟨U, hUo, hU⟩,
    refine ⟨coe '' U, is_open_image_coe.2 hUo, _⟩,
    simpa [coe_eq_coe] }
end

/-- The one point compactification of a `t1_space` space is a `t1_space`. -/
instance [t1_space X] : t1_space (alexandroff X) :=
{ t1 := λ z,
  begin
    induction z using alexandroff.rec,
    { exact is_closed_infty },
    { simp only [← image_singleton, is_closed_image_coe],
      exact ⟨is_closed_singleton, is_compact_singleton⟩ }
  end }

/-- The one point compactification of a locally compact Hausdorff space is a normal (hence,
Hausdorff and regular) topological space. -/
instance [locally_compact_space X] [t2_space X] : normal_space (alexandroff X) :=
begin
  have key : ∀ z : X,
    ∃ u v : set (alexandroff X), is_open u ∧ is_open v ∧ ↑z ∈ u ∧ ∞ ∈ v ∧ u ∩ v = ∅,
  { intro z,
    rcases exists_open_with_compact_closure z with ⟨u, hu, huy', Hu⟩,
    refine ⟨coe '' u, (coe '' closure u)ᶜ, is_open_image_coe.2 hu,
      is_open_compl_image_coe.2 ⟨is_closed_closure, Hu⟩, mem_image_of_mem _ huy',
      mem_compl infty_not_mem_image_coe, _⟩,
    rw [← subset_compl_iff_disjoint, compl_compl],
    exact image_subset _ subset_closure },
  refine @normal_of_compact_t2 _ _ _ ⟨λ x y hxy, _⟩,
  induction x using alexandroff.rec; induction y using alexandroff.rec,
  { exact (hxy rfl).elim },
  { rcases key y with ⟨u, v, hu, hv, hxu, hyv, huv⟩,
    exact ⟨v, u, hv, hu, hyv, hxu, (inter_comm u v) ▸ huv⟩ },
  { exact key x },
  { exact separated_by_open_embedding open_embedding_coe (mt coe_eq_coe.mpr hxy) }
end

/-- If `X` is not a compact space, then `alexandroff X` is a connected space. -/
instance [preconnected_space X] [noncompact_space X] : connected_space (alexandroff X) :=
{ to_preconnected_space := dense_embedding_coe.to_dense_inducing.preconnected_space,
  to_nonempty := infer_instance }

/-- If `X` is an infinite type with discrete topology (e.g., `ℕ`), then the identity map from
`cofinite_topology (alexandroff X)` to `alexandroff X` is not continuous. -/
lemma not_continuous_cofinite_topology_of_symm [infinite X] [discrete_topology X] :
  ¬(continuous (@cofinite_topology.of (alexandroff X)).symm) :=
begin
  inhabit X,
  simp only [continuous_iff_continuous_at, continuous_at, not_forall],
  use [cofinite_topology.of ↑(default : X)],
  simpa [nhds_coe_eq, nhds_discrete, cofinite_topology.nhds_eq]
    using (finite_singleton ((default : X) : alexandroff X)).infinite_compl
end

end alexandroff

/--
A concrete counterexample shows that  `continuous.homeo_of_equiv_compact_to_t2`
cannot be generalized from `t2_space` to `t1_space`.

Let `α = alexandroff ℕ` be the one-point compactification of `ℕ`, and let `β` be the same space
`alexandroff ℕ` with the cofinite topology.  Then `α` is compact, `β` is T1, and the identity map
`id : α → β` is a continuous equivalence that is not a homeomorphism.
-/
lemma continuous.homeo_of_equiv_compact_to_t2.t1_counterexample :
  ∃ (α β : Type) (Iα : topological_space α) (Iβ : topological_space β), by exactI
  compact_space α ∧ t1_space β ∧ ∃ f : α ≃ β, continuous f ∧ ¬ continuous f.symm :=
⟨alexandroff ℕ, cofinite_topology (alexandroff ℕ), infer_instance, infer_instance,
  infer_instance, infer_instance, cofinite_topology.of, cofinite_topology.continuous_of,
  alexandroff.not_continuous_cofinite_topology_of_symm⟩


/-
Copyright (c) 2022 Jannis Limperg. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sebastian Ullrich, Jannis Limperg
-/

import Aesop

set_option aesop.check.all true

namespace TBA

inductive List (α : Type) where
  | nil : List α
  | cons (head : α) (tail : List α) : List α

notation  (priority := high) "[" "]" => List.nil
infixr:67 (priority := high) " :: "  => List.cons

def filter (p : α → Prop) [DecidablePred p] (as : List α) : List α :=
  match as with
  | [] => []
  | a::as => if p a then a :: filter p as else filter p as

variable {p : α → Prop} [DecidablePred p] {as bs : List α}

@[simp]
theorem filter_cons_true (h : p a) : filter p (a :: as) = a :: filter p as := by
  simp [filter, h]

@[simp]
theorem filter_cons_false (h : ¬ p a) : filter p (a :: as) = filter p as := by
  simp [filter, h]

@[aesop 50% [constructors, cases]]
inductive Mem (a : α) : List α → Prop where
  | head {as} : Mem a (a::as)
  | tail {as} : Mem a as → Mem a (a'::as)

infix:50 " ∈ " => Mem

theorem mem_filter : a ∈ filter p as ↔ a ∈ as ∧ p a := by
  apply Iff.intro
  case mp =>
    intro h
    induction as with
    | nil => cases h
    | cons a' as ih => by_cases ha' : p a' <;> aesop
  case mpr =>
    intro h
    induction as with
    | nil => cases h.1
    | cons a' as ih =>
      cases h.1 with
      | head =>
        rw [filter_cons_true h.2]
        constructor
      | tail ha =>
        have : a ∈ filter p as := ih ⟨ha, h.2⟩
        by_cases hpa' : p a'
        case pos =>
          rw [filter_cons_true hpa']
          exact Mem.tail this
        case neg =>
          rw [filter_cons_false hpa']
          exact this

end TBA


/-
Copyright (c) 2021 OpenAI. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kunhao Zheng, Stanislas Polu, David Renshaw, OpenAI GPT-f
-/
import mathzoo.imports.miniF2F

open_locale nat rat real big_operators topological_space

theorem mathd_algebra_296 :
  abs (((3491 - 60) * (3491 + 60) - 3491^2):ℤ) = 3600 :=
begin
  rw abs_of_nonpos,
  norm_num,
  norm_num,
end


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

/-
A tactic which constructs exprs to discharge
goals of the form `clauses.unsat cs`.
-/

import tactic.omega.find_ees
import tactic.omega.find_scalars
import tactic.omega.lin_comb

namespace omega

open tactic

/-- Return expr of proof that given int is negative -/
meta def prove_neg : int → tactic expr
| (int.of_nat _) := failed
| -[1+ m] := return `(int.neg_succ_lt_zero %%`(m))

lemma forall_mem_replicate_zero_eq_zero (m : nat) :
  (∀ x ∈ (list.replicate m (0 : int)), x = (0 : int)) :=
λ x, list.eq_of_mem_replicate

/-- Return expr of proof that elements of (replicate is.length 0) are all 0 -/
meta def prove_forall_mem_eq_zero (is : list int) : tactic expr :=
return `(forall_mem_replicate_zero_eq_zero is.length)

/-- Return expr of proof that the combination of linear constraints
    represented by ks and ts is unsatisfiable -/
meta def prove_unsat_lin_comb (ks : list nat) (ts : list term) : tactic expr :=
let ⟨b,as⟩ := lin_comb ks ts in
do x1 ← prove_neg b,
   x2 ← prove_forall_mem_eq_zero as,
   to_expr ``(unsat_lin_comb_of %%`(ks) %%`(ts) %%x1 %%x2)

/-- Given a (([],les) : clause), return the expr of a term (t : clause.unsat ([],les)). -/
meta def prove_unsat_ef : clause → tactic expr
| ((_::_), _) := failed
| ([], les) :=
  do ks ← find_scalars les,
     x ← prove_unsat_lin_comb ks les,
     return `(unsat_of_unsat_lin_comb %%`(ks) %%`(les) %%x)

/-- Given a (c : clause), return the expr of a term (t : clause.unsat c)  -/
meta def prove_unsat (c : clause) : tactic expr :=
do ee ← find_ees c,
   x ← prove_unsat_ef (eq_elim ee c),
   return `(unsat_of_unsat_eq_elim %%`(ee) %%`(c) %%x)

/-- Given a (cs : list clause), return the expr of a term (t : clauses.unsat cs)  -/
meta def prove_unsats : list clause → tactic expr
| [] := return `(clauses.unsat_nil)
| (p::ps) :=
  do x ← prove_unsat p,
     xs ← prove_unsats ps,
     to_expr ``(clauses.unsat_cons %%`(p) %%`(ps) %%x %%xs)

end omega


import data.finsupp
import algebra.ring
import .to_finset
import .to_multiset
import to_semiring
import to_comm_semiring
import to_integral_domain

noncomputable theory

local infix ^ := monoid.pow

open classical
local attribute [instance] prop_decidable

universe u
variable {α : Type u}

--can the priority be set better? Because now we often have to provide parentheses
local notation a `~ᵤ` b : 50 := associated a b

namespace associated
open multiset

def setoid (β : Type u) [comm_semiring β] : setoid β :=
{ r := associated, iseqv := associated.eqv }
local attribute [instance] setoid

section comm_semiring
variable [comm_semiring α]

def quot (β : Type u) [comm_semiring β] : Type u := quotient (setoid β)

@[reducible] def mk (a : α) : quot α := ⟦ a ⟧ --important: Why did we define this? As we already have: ⟦ a ⟧?

lemma mk_def {a : α} : mk a = ⟦a⟧ := rfl
lemma mk_def' {a : α} : mk a = quot.mk setoid.r a := rfl

--naming?
lemma complete {a b : α} : mk a = mk b → (a ~ᵤ b) :=
begin
 intro h1,
 simp * at *,
 exact h1,
end

--This could simplify things
lemma associated_iff_mk_eq_mk {x y : α} : x ~ᵤ y ↔ mk x = mk y :=
iff.intro
  quot.sound
  complete

instance : has_zero (quot α) := ⟨⟦ 0 ⟧⟩
instance : has_one (quot α) := ⟨⟦ 1 ⟧⟩
instance : has_mul (quot α) :=
⟨λa' b', quotient.lift_on₂ a' b' (λa b, ⟦ a * b ⟧) $
  assume a₁ a₂ b₁ b₂ ⟨c₁, h₁⟩ ⟨c₂, h₂⟩, quotient.sound $
  ⟨c₁ * c₂, by simp [h₁, h₂, mul_assoc, mul_comm, mul_left_comm]⟩⟩

instance : comm_monoid (quot α) :=
{ one       := 1,
  mul       := (*),
  mul_one   := assume a', quotient.induction_on a' $
    assume a, show ⟦a * 1⟧ = ⟦ a ⟧, by simp,
  one_mul   := assume a', quotient.induction_on a' $
    assume a, show ⟦1 * a⟧ = ⟦ a ⟧, by simp,
  mul_assoc := assume a' b' c', quotient.induction_on₃ a' b' c' $
    assume a b c, show ⟦a * b * c⟧ = ⟦a * (b * c)⟧, by rw [mul_assoc],
  mul_comm  := assume a' b', quotient.induction_on₂ a' b' $
    assume a b, show ⟦a * b⟧ = ⟦b * a⟧, by rw [mul_comm] }

@[simp] lemma mk_zero_eq_zero : mk (0 : α) = 0 := rfl

--Would be nice to introduce a less strict order earlier on
instance : preorder (quot α) :=
{ le := λa b, ∃c, a * c = b,
  le_refl := assume a, ⟨1, by simp⟩,
  le_trans := assume a b c ⟨f₁, h₁⟩ ⟨f₂, h₂⟩,
    ⟨f₁ * f₂, h₂ ▸ h₁ ▸ (mul_assoc _ _ _).symm⟩}

def is_unit_quot (a : quot α) : Prop :=
quotient.lift_on a is_unit $
assume a b h, propext $ iff.intro
begin
  intro h1,
  apply is_unit_of_associated h1,
  exact h
end
begin
  intro h1,
  have h2 : b ≈ a,
  {cc},
  apply is_unit_of_associated h1,
  exact h2
end

lemma prod_mk {p : multiset α} : (p.map mk).prod = ⟦ p.prod ⟧ :=
multiset.induction_on p (by simp; refl) $
  assume a s ih, by simp [ih]; refl

lemma mul_mk {a b : α} : mk (a * b) = mk a * mk b :=
rfl

lemma zero_def : (0 : quot α) = ⟦ 0 ⟧ :=
rfl

lemma one_def : (1 : quot α) = ⟦ 1 ⟧ :=
rfl

@[simp] lemma mul_zero {a : quot α} : a * 0 = 0 :=
begin
  let a' := quot.out a,
  have h1 : mk a' = a,
  from quot.out_eq _,
  rw [←h1, zero_def, ← mul_mk],
  simp,
  exact rfl,
end

@[simp] lemma zero_mul {a : quot α} : 0 * a = 0 :=
begin
  let a' := quot.out a,
  have h1 : mk a' = a,
  from quot.out_eq _,
  rw [←h1, zero_def, ← mul_mk],
  simp,
  exact rfl,
end

lemma mk_eq_mk_iff_associated {a b : α} : mk a = mk b ↔ (a ~ᵤ b) :=
⟨ complete, quot.sound ⟩

lemma mk_eq_zero_iff_eq_zero {a : α} : mk a = 0 ↔ a = 0 :=
begin
  constructor,
  {
    intro h1,
    have h2 : (a ~ᵤ 0),
    from complete h1,
    rw associated_zero_iff_eq_zero at h2,
    exact h2,
  },
  {
     intro h1,
     rw h1,
     simp,
  }
end

/-
lemma associated_of_mul_eq_one {a b : α} (h1 : a * b = 1) : a ~ᵤ b :=
begin
  have h2 : b * a = 1,
  { rwa mul_comm a b at h1},
  have h3 : a * a * (b * b) = 1,
  { rwa [←mul_assoc, @mul_assoc _ _ a a _, h1, mul_one]},
  have h4 : b * b * (a * a) = 1,
  { rwa [mul_comm _ _] at h3},
  exact ⟨units.mk (a * a) (b * b) h3 h4, by {rw [units.val_coe], simp [mul_assoc, h1]}⟩,
end-/

lemma forall_associated_of_map_eq_map : ∀(p q : multiset α),
  p.map mk = q.map mk → rel_multiset associated p q :=
begin
assume p,
  apply multiset.induction_on p,
  {
    intro q,
    simp * at *,
    by_cases h1 : (q = 0),
    {
      simp * at *,
      exact rel_multiset.nil _,
    },
    {
      intro h2,
      have h3 : ∃ a, a ∈ q,
      from multiset.exists_mem_of_ne_zero h1,
      let a := some h3,
      have h4 : a ∈ q,
      from some_spec h3,
      have h5 : mk a ∈ (multiset.map mk q),
      from multiset.mem_map_of_mem mk h4,
      rw ← h2 at h5,
      by_contradiction h6,
      exact multiset.not_mem_zero _ h5,
    }

  },
  intros a p h1 q h3,
  simp * at *,
  have h4 : mk a ∈ multiset.map mk q,
  {
    rw ← h3,
    simp,
  },
  have h5 : ∃ t', multiset.map mk q = mk a :: t',
  from multiset.exists_cons_of_mem h4,
  let t' := some h5,
  have h6 : multiset.map mk q = mk a :: t',
  from some_spec h5,
  have h7 : ∃ b : α, b ∈ q ∧ mk b = mk a,
  {
    rw multiset.mem_map at h4,
    exact h4,
  },
  let b := some h7,
  have h8 : b ∈ q ∧ mk b = mk a,
  from some_spec h7,
  have h9 : ∃ t, q = b :: t,
  from multiset.exists_cons_of_mem (and.elim_left h8),
  let t := some h9,
  have h10 : q = b :: t,
  from some_spec h9,
  rw h10,
  have h11 : mk a = mk b,
  exact eq.symm (and.elim_right h8),
  apply rel_multiset.cons,
  {
    rw mk at h11,
    rw mk at h11,
    exact complete h11,
  },
  {
    apply h1 _,
    rw h10 at h3,
    simp at h3,
    rw [h11, multiset.cons_inj_right] at h3,
    exact h3,
  }
end

lemma multiset_eq (p q : multiset α) :
  rel_multiset associated p q ↔ p.map mk = q.map mk :=
begin
  constructor,
  {
    intro h1,
    induction h1 with a b h1 h2 h3 h4 h5,
    {
      exact rfl,
    },
    {
      simp [h5],
      exact h3
    },
  },
  {
    exact forall_associated_of_map_eq_map _ _
  },
end

--correct simp?
@[simp] lemma mk_unit_eq_one {u : units α} : mk (u : α) = 1 :=
begin
  apply quot.sound,
  exact unit_associated_one
end

lemma mk_eq_one_iff_is_unit {a : α} : mk a = 1 ↔ is_unit a :=
begin
  constructor,
  {
    intro h1,
    have h2 : is_unit_quot (mk a),
    {
      rw h1,
      exact is_unit_one
    },
    {
      exact h2,
    }
  },
  {
    intro h1,
    rcases h1 with ⟨u, hu⟩,
    subst hu,
    exact mk_unit_eq_one,
  }
end

lemma exists_eq_map_mk (p : multiset (quot α)) : ∃q:multiset α, p = q.map mk :=
multiset.induction_on p ⟨0, rfl⟩ $
  assume a', quotient.induction_on a' $ assume a p ⟨q, hq⟩,
  ⟨a :: q, by simp [hq]⟩

--Doens't this hold already for not is_unit? admit done, do we need this one.
 lemma prod_not_is_unit_quot_eq_one_iff_eq_zero {p : multiset (quot α)}: (∀ (a : quot α), a ∈ p → (¬ is_unit_quot a)) → (p.prod = 1 ↔ p = 0) :=
 begin
  intro h1a,
  constructor,
  {
    intro h2a,
    by_contradiction h1,
    have h2 : ∃a , a ∈ p,
    from multiset.exists_mem_of_ne_zero h1,
    let h := some h2,
    have h3 : h ∈ p,
    from some_spec h2,
    have h4 : ∃ t, p = h :: t,
    from multiset.exists_cons_of_mem h3,
    let t := some h4,
    have h5 : p = h :: t,
    from some_spec h4,
    rw h5 at h2a,
    simp at h2a,
    have h6 : ¬is_unit_quot h,
    from h1a h h3,
    let h' := quot.out h,
    have h7 : mk h' = h,
    from quot.out_eq h,
    have h8 : ∃t':multiset α, t = t'.map mk,
    from exists_eq_map_mk _,
    let t' := some h8,
    have h9 : t = t'.map mk,
    from some_spec h8,
    rw [h9, prod_mk, ←h7, ←mul_mk] at h2a,
    have h10 : ((h' * (multiset.prod t')) ~ᵤ (1 : α)),
    from complete h2a,
    rw asssociated_one_iff_is_unit at h10,
    --have h11: is_unit_quot (mk (h' * multiset.prod t')),
    --from h10,
    have h12 : is_unit h',
    from is_unit_left_of_is_unit_mul h10,
    have h13 : is_unit_quot (mk h'),
    from h12,
    rw h7 at h13,
    contradiction,
  },
  {
    intro h1,
    simp *,
  }
 end

--is eq_one better then is_unit_quot?
lemma is_unit_quot_of_mul_eq_one_left {a b : quot α} (h : a * b = 1) : is_unit_quot a :=
begin
  revert h,
  apply quot.induction_on a,
  apply quot.induction_on b,
  intros a' b' h,
  rw [←mk_def',←mk_def',←mul_mk, mk_eq_one_iff_is_unit] at h,
  have h1 : is_unit_quot (mk (b' * a')),
  from h,
  have h2 : is_unit b',
  from is_unit_left_of_is_unit_mul h1,
  exact h2,
end

lemma is_unit_quot_of_mul_eq_one_right {a b : quot α} (h : a * b = 1) : is_unit_quot b :=
begin
  rw mul_comm at h,
  exact is_unit_quot_of_mul_eq_one_left h,
end

lemma mul_mono {a b c d : quot α} (h₁ : a ≤ b) (h₂ : c ≤ d) : a * c ≤ b * d :=
let ⟨x, hx⟩ := h₁, ⟨y, hy⟩ := h₂ in
⟨x * y, by simp [hx.symm, hy.symm, mul_comm, mul_assoc, mul_left_comm]⟩

lemma le_mul_right {a b : quot α} : a ≤ a * b := ⟨b, rfl⟩

lemma le_mul_left {a b : quot α} : a ≤ b * a := by rw [mul_comm]; exact le_mul_right

lemma dvd_of_mk_le_mk {a b : α} (h : mk a ≤ mk b) : a ∣ b :=
let ⟨c', hc'⟩ := h in
(quotient.induction_on c' $ assume c (hc : mk (a * c) = mk b),
  have (a * c) ~ᵤ b, from complete hc,
  let ⟨d, hd⟩ := this.symm in
  ⟨d * c, by simp [mul_comm, mul_assoc, hd]⟩) hc'

lemma mk_le_mk_of_dvd {a b : α} (h : a ∣ b) : mk a ≤ mk b :=
let ⟨c, hc⟩ := h in ⟨mk c, by simp [hc]; refl⟩

lemma dvd_iff_mk_le_mk {a b : α} : a ∣ b ↔ mk a ≤ mk b :=
iff.intro mk_le_mk_of_dvd dvd_of_mk_le_mk

@[simp] lemma mk_quot_out {a : quot α} : mk (quot.out a) = a :=
quot.out_eq _

@[simp] lemma le_self {a : quot α} : a ≤ a:=
begin
  exact ⟨1, by simp⟩,
end

lemma is_unit_quot_iff_eq_one {a : quot α} : is_unit_quot a ↔ a = 1 :=
begin
  split,
  apply quot.induction_on a,
  {
    intros a h,
    apply quot.sound,
    apply (asssociated_one_iff_is_unit).2,
    exact h,
  },
  {
    intros h,
    rw [h, one_def, ←mk_def],
    exact is_unit_one,
  }
end

--open associated
lemma mul_eq_one_iff_eq_one_and_eq_one {a b : quot α} : a * b = 1 ↔ a = 1 ∧ b = 1 :=
begin
  apply @quotient.induction_on₂ _ _ (setoid α) (setoid α) _ a b,
  intros a b,
  rw [←mk_def, ←mk_def] {occs := occurrences.all},
  split,
  {
    intro h,
    rw [←mul_mk, one_def, ←mk_def] at h,
    have h1 : (a * b ~ᵤ 1),
    from complete h,
    have h2 : is_unit (a * b),
    from is_unit_of_associated is_unit_one h1.symm,
    have h3 : is_unit a,
    from is_unit_left_of_is_unit_mul h2,
    have h4 : is_unit b,
    from is_unit_right_of_is_unit_mul h2,
    repeat {rw ←is_unit_quot_iff_eq_one},
    split; assumption,
  },
  {
    intro h,
    simp * at *,
  }
end

/-
lemma le_of_mem_to_multiset {y : quot α} : ∀x ∈ to_multiset y, x ≤ y :=
begin
  intros x h1,
  by_cases h2 : y = 0,
  {
    simp * at *,
  },
  {
    rw ←to_multiset_prod_eq y h2,
    rcases (exists_cons_of_mem h1) with ⟨t, ht⟩,
    rw ht,
    simp * at *,
    exact le_mul_right,
  }
end
-/

end comm_semiring

section integral_domain
variable [integral_domain α]

instance : partial_order (quot α) :=
{
  le_antisymm := assume a' b',
    quotient.induction_on₂ a' b' $ assume a b ⟨f₁', h₁⟩ ⟨f₂', h₂⟩,
    (quotient.induction_on₂ f₁' f₂' $ assume f₁ f₂ h₁ h₂,
      let ⟨c₁, h₁⟩ := quotient.exact h₁.symm, ⟨c₂, h₂⟩ := quotient.exact h₂.symm in
      quotient.sound $ associated_of_dvd_dvd
        (h₁.symm ▸ dvd_mul_of_dvd_right (dvd_mul_right _ _) _)
        (h₂.symm ▸ dvd_mul_of_dvd_right (dvd_mul_right _ _) _)) h₁ h₂
  .. associated.preorder
}

--Think it should be le not subset
--lemma prod_le_prod_of_subset {p q : multiset (quot α)} (h : p ⊆ q) : p.prod ≤ q.prod :=
--Could we work with  lattice morphism?
lemma prod_le_prod_of_le {p q : multiset (quot α)} (h : p ≤ q) : p.prod ≤ q.prod :=
begin
  have h1 : p + (q - p) = q,
  from multiset.add_sub_of_le h,
  rw ← h1,
  simp,
  fapply exists.intro,
  exact multiset.prod (q - p),
  exact rfl,
end

lemma zero_ne_one : (0 : quot α) ≠ 1 :=
begin
  by_contradiction h1,
  simp [not_not] at *,
  have h2 : ((0 : α) ~ᵤ (1 : α)),
  {
    rw [zero_def, one_def] at h1,
    exact complete h1,
  },
  have h3 : ((1 : α) ~ᵤ (0 : α)),
  from associated.symm h2,
  rw associated_zero_iff_eq_zero at h3,
  have h4 : (0 : α) ≠ 1,
  from zero_ne_one,
  have h5 : (0 : α) = 1,
  from eq.symm h3,
  contradiction,
end

lemma mul_ne_zero {a' b' : quot α} (h1 : a' ≠ 0) (h2 : b' ≠ 0) : a' * b' ≠ 0 :=
begin
  let a := quot.out a',
  have h3 : mk a = a',
  from quot.out_eq a',
  let b := quot.out b',
  have h4 : mk b = b',
  from quot.out_eq b',
  rw [←h3, ←h4, ← mul_mk],
  rw [←h3, ne.def, mk_eq_zero_iff_eq_zero] at h1,
  rw [← h4, ne.def, mk_eq_zero_iff_eq_zero] at h2,
  rw [ne.def, mk_eq_zero_iff_eq_zero],
  exact mul_ne_zero h1 h2,
end

lemma le_def {a b : quot α} : a ≤ b = ∃ c, a * c = b := rfl

instance : lattice.order_bot (quot α) :=
{ bot := 1,
  bot_le := assume a, ⟨a, one_mul a⟩,
  .. associated.partial_order }

instance : lattice.order_top (quot α) :=
{ top := 0,
  le_top := assume a, ⟨0, mul_zero⟩,
  .. associated.partial_order }

lemma eq_zero_of_zero_le {a : quot α} : 0 ≤ a → a = 0 := lattice.top_unique

--0 is the largest element, division order
@[simp] lemma one_le_zero : (1 : quot α) ≤ (0 : quot α) := lattice.bot_le

lemma bot_def : ⊥ = (1 : quot α) := rfl
lemma top_def : ⊤ = (0 : quot α) := rfl

lemma zero_is_top (a : quot α) : a ≤ 0 := ⟨0, mul_zero⟩

lemma one_le :  ∀ (a : quot α), 1 ≤ a :=
assume a, ⟨a, by simp⟩

lemma eq_of_mul_eq_mul {a b c : quot α} : a ≠ 0 → a * b = a * c → b = c :=
quotient.induction_on₃ a b c $ assume a b c h eq,
  have a ≠ 0, from assume h', h $ mk_eq_zero_iff_eq_zero.2 h',
  let ⟨d, hd⟩ := complete eq in
  have a * b = a * (↑d * c), by simpa [mul_assoc, mul_comm, mul_left_comm] using hd,
  quotient.sound ⟨d, eq_of_mul_eq_mul_left_of_ne_zero ‹a ≠ 0› this⟩

lemma le_of_mul_le_mul {a b c : quot α} (h : a ≠ 0) : a * b ≤ a * c → b ≤ c
| ⟨d, hd⟩ :=
  have b * d = c, from eq_of_mul_eq_mul h $ by simpa [mul_assoc] using hd,
  ⟨d, this⟩

lemma prod_eq_zero_iff_zero_mem {s : multiset (quot α)} : prod s = 0 ↔ (0 : quot α) ∈ s :=
begin
  split,
  {
    apply multiset.induction_on s,
    {
      simp * at *,
      intro h1,
      exact zero_ne_one h1.symm,
    },
    {
      intros a s h1 h2,
      simp * at *,
      by_cases ha : a = 0,
      {
        simp * at *,
      },
      {
        have h3 : prod s = 0,
        {
          by_contradiction h4,
          have : a * prod s ≠ 0,
          from mul_ne_zero ha h4,
          contradiction,
        },
        simp [h1 h3],
      }
    }
  },
  {
    intro h,
    rcases (exists_cons_of_mem h) with ⟨t, ht⟩,
    subst ht,
    simp * at *,
  }
end

--irred

def irred (a : quot α) : Prop :=
quotient.lift_on a irreducible $
assume a b h, propext $ iff.intro
  (assume h', irreducible_of_associated h' h)
  (assume h', irreducible_of_associated h' h.symm)

--We don't need this one I think.
lemma irreducible_iff_mk_irred {a : α} : irreducible a ↔ irred (mk a) :=
begin
  --rw propext,
  constructor,
  {

    intro h1,
    exact h1, --Importatnt to understand this
  },
  {
    intro h1,
    exact h1, --Why does it work the other wat?
  }
end

lemma ne_one_of_irred {a : quot α} : irred a → a ≠ 1 :=
begin
  apply quotient.induction_on a,
  intro a,
  intro h1,
  have h2 : irreducible a,
  from h1,
  rw ne.def,
  rw [associated.has_one],
  rw mk_eq_mk_iff_associated,
  by_contradiction h3,
  have h4 : ¬ (is_unit a),
  from and.elim_left ( and.elim_right h2),
  rw asssociated_one_iff_is_unit at h3,
  contradiction,
end

lemma prod_irred_quot_eq_one_iff_eq_zero {p : multiset (quot α)}: (∀ (a : quot α), a ∈ p → (irred a)) → (p.prod = 1 ↔ p = 0) :=
begin
  intro h1,
  have h2 : ∀ (a : quot α), a ∈ p → (¬  is_unit_quot a),
  {
    intros b h2,
    have h3 : irred b,
    from h1 b h2,
    let b' := quot.out b,
    have h4  : mk b' = b,
    from quot.out_eq _,
    rw ← h4 at h3,
    have h5 : irreducible b',
    from h3,
    have h6 : ¬ is_unit b',
    from and.elim_left (and.elim_right h5),
    rw ← h4,
    exact h6,
  },
  apply prod_not_is_unit_quot_eq_one_iff_eq_zero,
  exact h2,
end

--Can possibly be simplified, because we have prod_ne_zero_of_ne_zero
lemma prod_ne_zero_of_irred {q : multiset (quot α)}: (∀ (a : quot α), a ∈ q → irred a) → multiset.prod q ≠ 0 :=
begin
  apply multiset.induction_on q,
  {
    intro h1,
    simp,
    apply ne.symm,
    exact zero_ne_one,
  },
  {
    intros a' s h1 h2,
    simp,
    have h3 : irred a',
    {
      apply h2 a',
      simp,
    },
    have h4 : (∀ (a : quot α), a ∈ s → irred a),
    {
      intros a h4,
      apply h2 a,
      simp *,
    },
    have h5 : multiset.prod s ≠ 0,
    from h1 h4,
    let a := quot.out a',
    have h6 : mk a = a',
    from quot.out_eq a',
    rw ← h6 at h3,
    have h7 : irreducible a,
    from h3,
    have h9 : a ≠ 0,
    from and.elim_left h7,
    have h10 : mk a ≠ 0,
    {
      rw [ne.def, mk_eq_zero_iff_eq_zero],
      exact h9,
    },
    apply mul_ne_zero,
    {
      rw h6 at h10,
      exact h10,
    },
    exact h5,

  }
end

lemma not_is_unit_quot_of_irred {a : quot α} (h : irred a) : ¬ is_unit_quot a :=
begin
  revert h,
  apply quot.induction_on a,
  intros a h,
  have : irreducible a,
  from h,
  have : ¬ is_unit a,
  from this.2.1,
  exact this,
end

lemma prod_ne_one_of_ne_zero_of_irred {q : multiset (quot α)} (h : q ≠ 0) : (∀ (a : quot α), a ∈ q → irred a) → multiset.prod q ≠ 1 :=
begin
  revert h,
  apply multiset.induction_on q,
  {
    simp * at *,
  },
  {
    intros a s h1 h2 h3,
    simp * at *,
    by_contradiction h4,
    have h5 : is_unit_quot a,
    from is_unit_quot_of_mul_eq_one_left h4,
    have : ¬is_unit_quot a,
    {
      apply not_is_unit_quot_of_irred,
      apply h3,
      simp,
    },
    contradiction,
  }
end

lemma ne_zero_of_irred {a : quot α} (h : irred a) : a ≠ 0 :=
begin
  revert h,
  apply quot.induction_on a,
  intros a h,
  simp,
  have h1 : irreducible a,
  from h,
  have h2 : a ≠ 0,
  from h1.1,
  rw [←mk_def'],
  rw @mk_eq_zero_iff_eq_zero _ _ a,
  exact h2,
end

@[simp] lemma not_irred_one : ¬ irred (1 : quot α) :=
not_irreducible_one

lemma one_def' : mk (1 : α) = 1 := rfl

lemma forall_map_mk_irred_of_forall_irreducible {s : multiset α}(h : ∀x ∈ s, irreducible x) : ∀ x ∈ map mk s, irred x :=
begin
  intros x,
  apply quot.induction_on x,
  intros a h1,
  rw mem_map at h1,
  rcases h1 with ⟨b, hb⟩,
  rw ← hb.2,
  exact h b hb.1,
end

end integral_domain

-- Can we Prove the existence of a gcd here? Problem is has_dvd, why is it not defined here??
--If we can show the existence of a gcd here, we can reuse some lemmas

end associated


open function

structure distinct (size : ℕ) (α : Type) : Type :=
    (f : fin size → α)
    (injective : injective f)

namespace distinct
section
parameter {size : ℕ}
parameter {α : Type}
definition to_set (d : distinct size α) : set α :=
    λ a : α, ∃ i, d.f i = a

instance distinct_has_coe : has_coe (distinct size α) (set α)
    := has_coe.mk to_set
end

namespace unordered
section
open fin
open distinct
parameter size : ℕ
parameter α : Type

open function.equiv

private definition eqv (d0 d1 : distinct size α) : Prop :=
    d0.to_set = d1.to_set

private lemma eqv_is_equiv : equivalence eqv :=
    begin repeat {split}
        ; unfold reflexive symmetric transitive eqv
        ; intro x
    , {reflexivity}
    , {intros y h, symmetry, exact h}
    , {intros y z xy yz, transitivity (to_set y); assumption}
    end

instance setoid : setoid (distinct size α) :=
    setoid.mk _ eqv_is_equiv

definition unordered : Type := quotient setoid
end

section
parameter {size : ℕ}
parameter {α : Type}
definition to_set_respects
    : ∀ a b : (distinct size α), a ≈ b → to_set a = to_set b :=
    begin intros a b h
    , unfold has_equiv.equiv setoid.r eqv at h
    , exact h
    end

definition to_set := quotient.lift to_set to_set_respects
end

instance has_lift (n : ℕ) (α : Type)
    : has_lift (unordered n α) (set α) :=
has_lift.mk to_set

end unordered

definition unordered := unordered.unordered
end distinct
open distinct.unordered

namespace line_geometry
section
notation `double` a :100 := (unordered 2 a : Type)
open distinct
parameters (Point Line : Type)

class line_geometry
    [has_lift Line (set Point)] :=
    mk ::
    (fixed_by : double Point → Line)
    (fixed_by_correct
        : ∀ (pt : double Point) (l : Line), 1 ≤ 2)

end
end line_geometry

namespace curve_geometry
section
notation `tripple` a :100 := (unordered 3 a : Type)
open distinct
parameters (Point Curve : Type)
class curve_geometry
    [has_lift Curve (set Point)] :=
    (fixed_by : tripple Point → Curve)
    (fixed_by_correct
        : ∀ (pt : tripple Point) (c : Curve)
            , ↑pt ⊆ (↑c : set Point) ↔ c = fixed_by pt)

end
end curve_geometry

notation `curve_geometry` := curve_geometry.curve_geometry


/-
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
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.topology.category.Top.basic
import Mathlib.measure_theory.giry_monad
import Mathlib.category_theory.monad.algebra
import Mathlib.PostPort

universes u u_1

namespace Mathlib

/-
* Meas, the category of measurable spaces

Measurable spaces and measurable functions form a (concrete) category Meas.

Measure : Meas ⥤ Meas is the functor which sends a measurable space X
to the space of measures on X; it is a monad (the "Giry monad").

Borel : Top ⥤ Meas sends a topological space X to X equipped with the
σ-algebra of Borel sets (the σ-algebra generated by the open subsets of X).

## Tags

measurable space, giry monad, borel

-/

/-- The category of measurable spaces and measurable functions. -/
def Meas :=
  category_theory.bundled measurable_space

namespace Meas

protected instance measurable_space (X : Meas) : measurable_space ↥X :=
  category_theory.bundled.str X

/-- Construct a bundled `Meas` from the underlying type and the typeclass. -/
def of (α : Type u) [measurable_space α] : Meas :=
  category_theory.bundled.mk α

@[simp] theorem coe_of (X : Type u) [measurable_space X] : ↥(of X) = X :=
  rfl

protected instance unbundled_hom : category_theory.unbundled_hom measurable :=
  category_theory.unbundled_hom.mk measurable_id measurable.comp

protected instance large_category : category_theory.large_category Meas :=
  category_theory.bundled_hom.category
    fun (α β : Type u_1) (Iα : measurable_space α) (Iβ : measurable_space β) => Subtype measurable

protected instance inhabited : Inhabited Meas :=
  { default := of empty }

/-- `Measure X` is the measurable space of measures over the measurable space `X`. It is the
weakest measurable space, s.t. λμ, μ s is measurable for all measurable sets `s` in `X`. An
important purpose is to assign a monadic structure on it, the Giry monad. In the Giry monad,
the pure values are the Dirac measure, and the bind operation maps to the integral:
`(μ >>= ν) s = ∫ x. (ν x) s dμ`.

In probability theory, the `Meas`-morphisms `X → Prob X` are (sub-)Markov kernels (here `Prob` is
the restriction of `Measure` to (sub-)probability space.)
-/
def Measure : Meas ⥤ Meas :=
  category_theory.functor.mk
    (fun (X : Meas) => category_theory.bundled.mk (measure_theory.measure (category_theory.bundled.α X)))
    fun (X Y : Meas) (f : X ⟶ Y) => { val := ⇑(measure_theory.measure.map ↑f), property := sorry }

/-- The Giry monad, i.e. the monadic structure associated with `Measure`. -/
protected instance Measure.category_theory.monad : category_theory.monad Measure :=
  category_theory.monad.mk
    (category_theory.nat_trans.mk fun (X : Meas) => { val := measure_theory.measure.dirac, property := sorry })
    (category_theory.nat_trans.mk fun (X : Meas) => { val := measure_theory.measure.join, property := sorry })

/-- An example for an algebra on `Measure`: the nonnegative Lebesgue integral is a hom, behaving
nicely under the monad operations. -/
def Integral : category_theory.monad.algebra Measure :=
  category_theory.monad.algebra.mk (of ennreal)
    { val := fun (m : measure_theory.measure ennreal) => measure_theory.lintegral m fun (x : ennreal) => x,
      property := sorry }

end Meas

protected instance Top.has_forget_to_Meas : category_theory.has_forget₂ Top Meas :=
  category_theory.bundled_hom.mk_has_forget₂ borel
    (fun (X Y : category_theory.bundled topological_space) (f : X ⟶ Y) =>
      { val := continuous_map.to_fun f, property := sorry })
    sorry

/-- The Borel functor, the canonical embedding of topological spaces into measurable spaces. -/
def Borel : Top ⥤ Meas :=
  category_theory.forget₂ Top Meas


import algebra.big_operators.basic

open_locale big_operators

namespace finset
variables {α β : Type*} [comm_monoid β]

@[to_additive prod_eq_card_nsmul]
lemma prod_eq_pow_card (s : finset α) (f : α → β) (m : β) (h : ∀ x ∈ s, f x = m) :
  ∏ a in s, f a = m ^ s.card :=
(prod_congr rfl h).trans $ prod_const _

end finset


/-
Copyright (c) 2018 Simon Hudon. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Simon Hudon, Patrick Massot
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.tactic.pi_instances
import Mathlib.algebra.group.pi
import Mathlib.algebra.ring.basic
import Mathlib.PostPort

universes u v w u_1 u_2

namespace Mathlib

/-!
# Pi instances for ring

This file defines instances for ring, semiring and related structures on Pi Types
-/

namespace pi

protected instance distrib {I : Type u} {f : I → Type v} [(i : I) → distrib (f i)] : distrib ((i : I) → f i) :=
  distrib.mk Mul.mul Add.add sorry sorry

protected instance semiring {I : Type u} {f : I → Type v} [(i : I) → semiring (f i)] : semiring ((i : I) → f i) :=
  semiring.mk Add.add sorry 0 sorry sorry sorry Mul.mul sorry 1 sorry sorry sorry sorry sorry sorry

protected instance comm_semiring {I : Type u} {f : I → Type v} [(i : I) → comm_semiring (f i)] : comm_semiring ((i : I) → f i) :=
  comm_semiring.mk Add.add sorry 0 sorry sorry sorry Mul.mul sorry 1 sorry sorry sorry sorry sorry sorry sorry

protected instance ring {I : Type u} {f : I → Type v} [(i : I) → ring (f i)] : ring ((i : I) → f i) :=
  ring.mk Add.add sorry 0 sorry sorry Neg.neg (fun (ᾰ ᾰ_1 : (i : I) → f i) (i : I) => ring.sub (ᾰ i) (ᾰ_1 i)) sorry sorry
    Mul.mul sorry 1 sorry sorry sorry sorry

protected instance comm_ring {I : Type u} {f : I → Type v} [(i : I) → comm_ring (f i)] : comm_ring ((i : I) → f i) :=
  comm_ring.mk Add.add sorry 0 sorry sorry Neg.neg (fun (ᾰ ᾰ_1 : (i : I) → f i) (i : I) => comm_ring.sub (ᾰ i) (ᾰ_1 i))
    sorry sorry Mul.mul sorry 1 sorry sorry sorry sorry sorry

/-- A family of ring homomorphisms `f a : γ →+* β a` defines a ring homomorphism
`pi.ring_hom f : γ →+* Π a, β a` given by `pi.ring_hom f x b = f b x`. -/
protected def ring_hom {α : Type u} {β : α → Type v} [R : (a : α) → semiring (β a)] {γ : Type w} [semiring γ] (f : (a : α) → γ →+* β a) : γ →+* (a : α) → β a :=
  ring_hom.mk (fun (x : γ) (b : α) => coe_fn (f b) x) sorry sorry sorry sorry

@[simp] theorem ring_hom_apply {α : Type u} {β : α → Type v} [R : (a : α) → semiring (β a)] {γ : Type w} [semiring γ] (f : (a : α) → γ →+* β a) (g : γ) (a : α) : coe_fn (pi.ring_hom f) g a = coe_fn (f a) g :=
  rfl

end pi

/-- Evaluation of functions into an indexed collection of monoids at a point is a monoid
homomorphism. -/
def ring_hom.apply {I : Type u_1} (f : I → Type u_2) [(i : I) → semiring (f i)] (i : I) : ((i : I) → f i) →+* f i :=
  ring_hom.mk (monoid_hom.to_fun (monoid_hom.apply f i)) sorry sorry sorry sorry

@[simp] theorem ring_hom.apply_apply {I : Type u_1} (f : I → Type u_2) [(i : I) → semiring (f i)] (i : I) (g : (i : I) → f i) : coe_fn (ring_hom.apply f i) g = g i :=
  rfl


import tactic
import data.real.basic
import data.complex.exponential
import analysis.special_functions.pow

noncomputable theory
open_locale classical

open real

notation `|`x`|` := abs x

variables (a : ℝ) (b : ℝ)
/-!
## p-GTFs

This is my speciality but it _needs_ integration, so this won't be able to be
filled in until somebody produces some sort of integration in lean or I prove it
out of spite for not having it.

I've actually remembered that we can define the πₚ function.
-/

def pip (p : ℝ) := (2 * pi)/ (p * sin (pi / p))

-- def sinp (p : ℝ) := sorry

-- def cosp (p : ℝ) := sorry

example (h : a * b = 0) : a = 0 ∨ b = 0 := zero_eq_mul.mp (eq.symm h)

private lemma lt_mul_eq_zero (fab : a < b) (fa : 0 < a) (fb : 0 < b) : 0 < a * b ↔ 0 < a ∨ 0 < b :=
begin
  split,
  intro famulb,
  left,
  exact fa,
  intro famulb,
  rw zero_lt_mul_left,
  exact fb, exact fa,
end

lemma pip_monotone_decreasing : strict_mono_decr_on pip {p : ℝ | 1 < p} :=
begin
  rintros a fa b fb fab,

    have one_lt_b : 1 < b,
    {apply fb},
    have one_lt_a : 1 < a,
    {apply fa},
    have a_pos : 0 < a := by linarith,
    have b_pos : 0 < b := by linarith,
    have two_pi_pos : 0 < 2 * pi, {norm_num, exact pi_pos},
    have pi_a_lt_pi_b : pi/b < pi/a := by {apply div_lt_div', refl, exact fab, exact pi_pos, exact a_pos,},
    have pi_on_b_pos : pi / b < pi := by {rw div_lt_iff b_pos, refine sub_pos.mp _, rw ←mul_one (pi),
      rw mul_assoc, rw one_mul (b), rw ←mul_sub, refine (div_lt_iff _).mp _,
      /-  ⊢ 0 < b - 1  -/
      { norm_num, exact one_lt_b,},
      /-  ⊢ 0 / (b - 1) < pi  -/
      {rw zero_div, exact pi_pos,},
    },
    have pi_on_a_pos : pi / a < pi := by {rw div_lt_iff a_pos, refine sub_pos.mp _, rw ←mul_one (pi),
      rw mul_assoc, rw one_mul (a), rw ←mul_sub, refine (div_lt_iff _).mp _,
      /-  ⊢ 0 < b - 1  -/
      { norm_num, exact one_lt_a,},
      /-  ⊢ 0 / (b - 1) < pi  -/
      {rw zero_div, exact pi_pos,},
    },

    have pi_b_pos : 0 < pi/b := by { refine div_pos _ b_pos, exact pi_pos,},
    have pi_a_pos : 0 < pi/a := by { refine div_pos _ a_pos, exact pi_pos,},
    have sin_pi_b_pos : 0 < sin(pi/b),
    {exact sin_pos_of_pos_of_lt_pi pi_b_pos pi_on_b_pos,},
    have sin_pi_a_pos : 0 < sin(pi/a),
    {exact sin_pos_of_pos_of_lt_pi pi_a_pos pi_on_a_pos,},

    have sin_fa_lt_sin_fb : sin (pi/a) < sin (pi/b) := sorry,
    /-/- This changes, depending on whether x ∈ (1, 2] or x ∈ (2, ∞). For x < 2, we get
    that f a < f b, however for 2 < x we get f b < f a -/
    {
        apply sin_lt_sin_of_le_of_le_pi_div_two,
        linarith,
        {
          sorry
        },
        -- pi/a < pi/b for all ∀ a < b : b > 2 which is false. So something else must be false
    sorry}, -/

  unfold pip,
  rw div_eq_mul_one_div,
  rw div_eq_mul_one_div _ (a*sin(pi/a)),
  rw mul_lt_mul_left two_pi_pos,
  repeat {rw one_div_eq_inv},
  rw inv_lt_inv,
  /-
⊢ a * sin (pi / a) < b * sin (pi / b)
-/
    {refine (div_lt_div_iff sin_pi_b_pos sin_pi_a_pos).mp _,
    refine div_lt_div' _ sin_fa_lt_sin_fb b_pos sin_pi_a_pos,
    exact le_of_lt fab,},
  /-
⊢ 0 < b * sin (pi / b)
-/
   {refine mul_pos b_pos sin_pi_b_pos,},
  /-
⊢ 0 < a * sin (pi / a)
-/
    {refine mul_pos a_pos sin_pi_a_pos,},
end

#exit

-- this is a mess. Please ignore below thiss

example (p : ℝ) : pip p ≤ 16 / (pi ^ 2 - 8) :=
begin
  unfold pip,
  have H : p * sin(pi/p) ≠ 0,
  {intros f,
   --rw zero_eq_mul at f,
   sorry
  }, sorry
end

lemma pip_monotone (a b : ℝ) (ga : 1 < a) (gb : 1 < b) : a < b → pip b < pip a :=
begin
  have h : 0 < 2 * pi, {norm_num, exact pi_pos},
  rintros fab,
  unfold pip,
  rw div_eq_mul_one_div,
  rw div_eq_mul_one_div _ (a*sin(pi/a)),
  rw mul_lt_mul_left h,
  repeat {rw one_div_eq_inv},
  rw inv_lt_inv,
  {
    apply mul_lt_mul,
    {exact fab,},
    {
      -- sin(π / a) ≤ sin(π / b)
      sorry
      },
    {
      -- 0 < sin (π / a)
      sorry },
    {linarith}
  },
  {
    -- 0 < b * sin (π / b)
    have H : 0 < pi / b ∧ pi / b < pi,
    {split,
    {
      have pi_pos : 0 < pi := pi_pos,
      rw div_eq_inv_mul,
      --finish,
      sorry
    },
    {
      have pi_pos : 0 < pi := pi_pos,
      rw div_eq_inv_mul,
      --apply lt_mul_of_inv_mul_lt_left,
    sorry
    },},
    /-
    Basically this follows the proof that we know 0 < π/b < π as b > 1 → 0 < sin (π / b) < π
    and we know t ∈ [0, π] then 0 < sin t.
    -/

  },
  {
    -- 0 < a * sin (π / b)
    sorry
  }
end

--example (a b c : ℝ) (h : a = b⁻¹ * c) (g : b ≠ 0) : a * b = c := by library_search

#exit


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

import Mathlib.Tactic.Set
import Mathlib.Tactic.Basic

example (x : Nat) (h : x = x) : x = x := by
  set! p := h
  set q : x = x := p
  apply q

example (x : Nat) (h : x + x - x = 3) : x + x - x = 3 := by
  set! y := x with ← h2
  set w := x
  guard_hyp y := x
  guard_hyp w := x
  guard_hyp h : w + w - w = 3
  guard_hyp h2 : w = y
  set z := w with _h3
  set a := 3
  guard_target = z + z - z = a
  set i'm_the_goal : Prop := z + z - z = a
  guard_target = i'm_the_goal
  apply h

example (x : Nat) (h : x - x = 0) : x = x := by
  set y : Nat := x
  set! z := y + 1 with ← _eq1
  set! p : x - x = 0 := h with _eq2
  rfl


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' X => 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 g list_inj.empty) => f
| _, _, _, (prod_mk_prod f g list_inj.empty) => f
| _, _, _, (prod_mk_coprod f g) => 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 f g list_inj.empty) => g
| _, _, _, (prod_mk_prod f g list_inj.empty) => g
| _, _, _, (prod_mk_coprod f 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 f g list_inj.empty) => rfl
| _, _, _, (prod_mk_prod f g list_inj.empty) => rfl
| _, _, _, (prod_mk_coprod f g) => rfl

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 h) => g
| _, _, _, (coprod_mk_coprod list_proj.empty g h) => 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 g h) => h
| _, _, _, (coprod_mk_coprod list_proj.empty g 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]

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 V W), X, Y, Z, 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

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
| X, Y, Z, (prod V W), 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

@[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

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
| prod_mk {W X Y Z : prod_coprod C}
  (f : norm_hom2 W X) (g : norm_hom2 W Y)
  (h : list_inj (prod X Y) Z) :
  norm_hom2 W Z
| coprod_mk {W X Y Z : prod_coprod C}
  (f : list_proj W (coprod X Y))
  (g : norm_hom2 X Z) (h : norm_hom2 Y Z) :
  norm_hom2 W 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_hom2 W Z

namespace norm_hom2

@[simp] def size : {X Y : prod_coprod C} → norm_hom2 X Y → Nat
| _, _, prod_mk f g h => size f + size g + 1
| _, _, of_cat f g h => 0
| _, _, coprod_mk f g h => size g + size h + 1

-- @[simp] theorem size_prod_mk {W X Y Z : prod_coprod C} (f : norm_hom2 W X) (g : norm_hom2 W Y)
--   (h : list_inj (prod X Y) Z) : size (prod_mk f g h) = size f + size g + 1 := rfl

-- @[simp] theorem size_coprod_mk {W X Y Z : prod_coprod C} (f : list_proj W (coprod X Y))
--   (g : norm_hom2 X Z) (h : norm_hom2 Y Z) :
--   size (coprod_mk f g h) = size g + size h + 1 := rfl

@[simp] def comp_fst : {X Y Z : prod_coprod C} → (f : norm_hom2 X (prod Y Z)) → norm_hom2 X Y
| _, _, _, prod_mk f g list_inj.empty => f
| _, _, _, coprod_mk f g h => coprod_mk f (comp_fst g) (comp_fst h)

@[simp] def comp_snd : {X Y Z : prod_coprod C} → (f : norm_hom2 X (prod Y Z)) → norm_hom2 X Z
| _, _, _, (prod_mk f g list_inj.empty) => g
| _, _, _, (coprod_mk f g h) => coprod_mk f (comp_snd g) (comp_snd h)

@[simp] def inl_comp : {X Y Z : prod_coprod C} → (f : norm_hom2 (coprod X Y) Z) → norm_hom2 X Z
| _, _, _, coprod_mk list_proj.empty g h => g
| _, _, _, prod_mk f g h => prod_mk (inl_comp f) (inl_comp g) h

@[simp] def inr_comp : {X Y Z : prod_coprod C} → (f : norm_hom2 (coprod X Y) Z) → norm_hom2 Y Z
| _, _, _, coprod_mk list_proj.empty g h => h
| _, _, _, prod_mk f g h => prod_mk (inr_comp f) (inr_comp g) h

@[simp] def fst_comp : {X Y Z : prod_coprod C} →
  (f : norm_hom2 X Z) → norm_hom2 (prod X Y) Z
| _, _, _, prod_mk f g h => prod_mk (fst_comp f) (fst_comp g) h
| _, _, _, coprod_mk f g h => coprod_mk f.fst_comp g h
| _, _, _, of_cat f g h => of_cat f.fst_comp g h

@[simp] def snd_comp : {X Y Z : prod_coprod C} →
  (f : norm_hom2 Y Z) → norm_hom2 (prod X Y) Z
| _, _, _, prod_mk f g h => prod_mk (snd_comp f) (snd_comp g) h
| _, _, _, coprod_mk f g h => coprod_mk f.snd_comp g h
| _, _, _, of_cat f g h => of_cat f.snd_comp g h

@[simp] def comp_inl : {X Y Z : prod_coprod C} →
  (f : norm_hom2 X Y) → norm_hom2 X (coprod Y Z)
| _, _, _, coprod_mk f g h => coprod_mk f (comp_inl g) (comp_inl h)
| _, _, _, prod_mk f g h => prod_mk f g h.comp_inl
| _, _, _, of_cat f g h => of_cat f g h.comp_inl

@[simp] def comp_inr : {X Y Z : prod_coprod C} →
  (f : norm_hom2 X Z) → norm_hom2 X (coprod Y Z)
| _, _, _, coprod_mk f g h => coprod_mk f (comp_inr g) (comp_inr h)
| _, _, _, prod_mk f g h => prod_mk f g h.comp_inr
| _, _, _, of_cat f g h => of_cat f g h.comp_inr

@[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.of_cat f g h
| _, _, norm_hom.prod_mk_of_cat f g h => norm_hom2.prod_mk f.to_norm_hom2 g.to_norm_hom2 h
| _, _, norm_hom.prod_mk_prod f g h => norm_hom2.prod_mk f.to_norm_hom2 g.to_norm_hom2 h
| _, _, norm_hom.prod_mk_coprod f g => norm_hom2.prod_mk f.to_norm_hom2 g.to_norm_hom2 list_inj.empty
| _, _, norm_hom.coprod_mk_of_cat f g h => norm_hom2.coprod_mk f g.to_norm_hom2 h.to_norm_hom2
| _, _, norm_hom.coprod_mk_coprod f g h => norm_hom2.coprod_mk f g.to_norm_hom2 h.to_norm_hom2

@[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 g h => norm_hom.of_cat f g h
| _, _, norm_hom2.coprod_mk f g h => norm_hom.coprod_mk_l f g.to_norm_hom h.to_norm_hom
| _, _, norm_hom2.prod_mk f g h => norm_hom.prod_mk_l f.to_norm_hom g.to_norm_hom h

@[simp] def norm_hom2.comp : {X Y Z : prod_coprod C} → (f : norm_hom2 X Y) →
  (g : norm_hom2 Y Z) → norm_hom2 X Z
| _, _, _, coprod_mk f g h, i => coprod_mk f (comp g i) (comp h i)
| _, _, _, of_cat j k l, prod_mk g h i =>
  prod_mk (comp (of_cat j k l) g) (comp (of_cat j k l) h) i
| _, _, _, prod_mk j k l, prod_mk g h i =>
  prod_mk (comp (prod_mk j k l) g) (comp (prod_mk j k l) h) i
| _, _, _, of_cat f g list_inj.empty, of_cat list_proj.empty j k => of_cat f (g ≫ j) k
| _, _, _, of_cat f g (list_inj.comp_inl h), coprod_mk list_proj.empty j k =>
  comp (of_cat f g h) j
| _, _, _, of_cat f g (list_inj.comp_inr h), coprod_mk list_proj.empty j k =>
  comp (of_cat f g h) k
| _, _, _, prod_mk f g list_inj.empty, of_cat (list_proj.fst_comp h) i j =>
  comp f (of_cat h i j)
| _, _, _, prod_mk f g list_inj.empty, of_cat (list_proj.snd_comp h) i j =>
  comp g (of_cat h i j)
| _, _, _, prod_mk f g list_inj.empty, coprod_mk (list_proj.fst_comp i) j k =>
  comp f (coprod_mk i j k)
| _, _, _, prod_mk f g list_inj.empty, coprod_mk (list_proj.snd_comp i) j k =>
  comp g (coprod_mk i j k)
| _, _, _, prod_mk f g (list_inj.comp_inl i), coprod_mk list_proj.empty j k =>
  comp (prod_mk f g i) j
| _, _, _, prod_mk f g (list_inj.comp_inr i), coprod_mk list_proj.empty j k =>
  comp (prod_mk f g i) k
termination_by comp X Y Z f g => prod_coprod.size X

example : 1 = 1 := rfl

-- theorem norm_hom2.comp_assoc_aux : {W X X' Y Y' Z : prod_coprod C} →
--   (f : norm_hom2 W X) → (g : norm_hom2 X' Y) → (h : norm_hom2 Y' Z) →
--   (hX : X = X') → (hY : Y = Y') →
--   ((f.comp (show norm_hom2 X Y by rw [hX]; exact g)).comp
--     (show norm_hom2 Y Z by rw [hY]; exact h)).to_norm_hom =
--     (f.comp ((show norm_hom2 X Y by rw [hX]; exact g).comp
--      (show norm_hom2 Y Z by rw [hY]; exact h))).to_norm_hom := by
-- intros W X X' Y Y' Z f g h hX hY
-- induction f <;> simp at * <;>
-- induction g <;> cases hX <;> simp at *
-- induction h <;> cases hY <;> simp [*, Eq.mpr] at *

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
| _, _, _, _, coprod_mk f g h, i, k => by
  rw [norm_hom2.comp, norm_hom2.comp, norm_hom2.comp,
    norm_hom2.to_norm_hom, norm_hom2.to_norm_hom,
    comp_assoc, comp_assoc]
| _, _, _, _, f, of_cat _ _ _, prod_mk h i j => by
  simp [norm_hom2.comp, norm_hom2.to_norm_hom]
  rw [comp_assoc, norm_hom2.comp]
| _, _, _, _, f, prod_mk _ _ _, prod_mk h i j => by
  simp [norm_hom2.comp, norm_hom2.to_norm_hom]
  rw [comp_assoc, norm_hom2.comp]
| _, _, _, _, of_cat f g list_inj.empty, of_cat list_proj.empty h list_inj.empty,
    of_cat list_proj.empty i j => by
  simp [norm_hom2.comp, category.assoc]

termination_by comp_assoc f g h => (size f + size g + size h)

-- induction f <;>
-- induction g <;>
-- cases hX <;>
-- induction h <;>
-- cases hY <;>
-- --simp at [*]

-- def comp_fst : Π {X Y Z : prod_coprod C} (f : norm_hom X (prod Y Z)), norm_hom X Y
-- | _ _ _ (@prod_mk_of_cat _ _ W X Y Z f g empty) := f
-- | A B D (@prod_mk_prod _ _ V W X Y Z f g empty) := f
-- | A B D (@prod_mk_coprod _ _ W X Y Z f g) := 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 _ _ W X Y Z f g empty) := g
-- | A B D (@prod_mk_prod _ _ V W X Y Z f g empty) := g
-- | A B D (@prod_mk_coprod _ _ W X Y Z f 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 f g empty) := rfl
-- | _ _ _ (prod_mk_prod f g empty) := rfl
-- | _ _ _ (prod_mk_coprod f g) := rfl

-- 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) :=
-- begin
--   intros,
--   cases Y;
--   dsimp [coprod_mk, comp_fst]; refl
-- end

-- 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) :=
-- begin
--   intros,
--   cases Y;
--   dsimp [coprod_mk, comp_fst]; refl
-- end

-- def inl_comp : Π {X Y Z : prod_coprod C}, norm_hom (coprod X Y) Z → norm_hom X Z
-- | _ _ _ (coprod_mk_of_cat empty g h) := g
-- | _ _ _ (coprod_mk_coprod empty g h) := g
-- | _ _ _ (@prod_mk_coprod _ _ W X Y Z 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 empty g h) := h
-- | _ _ _ (coprod_mk_coprod empty g h) := h
-- | _ _ _ (@prod_mk_coprod _ _ W X Y Z 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)
-- | A B D _ (prod_mk_coprod f g) := by simp [comp_fst, inl_comp]

-- 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)
-- | A B D _ (prod_mk_coprod f g) := by simp [comp_fst, inr_comp]

-- 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 simp [comp_snd, inl_comp]

-- 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)
-- | A B D _ (prod_mk_coprod f g) := by simp [comp_snd, inr_comp]

-- @[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 empty g h) := rfl
-- | _ _ _ (coprod_mk_coprod empty g h) := rfl
-- | _ _ _ (prod_mk_coprod f g) :=
--   by simp [coprod_mk, inl_comp, inr_comp, coprod_eta f, coprod_eta g]

-- 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 V W) X Y Z 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

-- 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
-- | X Y Z (prod V W) 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

def comp {X Y Z : prod_coprod C} {b₁ b₂ : bool} (f : norm_hom b₁  X Y) (g : norm_hom b₂ Y Z) :
  Σ b : bool, norm_hom b X Z :=
norm_hom2.to_norm_hom (norm_hom2.comp (to_norm_hom2 f) g.to_norm_hom2)

@[simp] def norm_syn : Π {X Y : prod_coprod C} (f : syn X Y),
  Σ b : bool, norm_hom b X Y
| _ _ (syn.of_cat f) := ⟨ff, norm_hom.of_cat f⟩
| _ _ (syn.id _) := ⟨_, norm_hom.id _⟩
| _ _ (syn.comp f g) := (norm_syn f).2.comp (norm_syn g).2
| _ _ syn.fst := norm_hom.fst_comp (norm_hom.id _)
| _ _ syn.snd := norm_hom.snd_comp (norm_hom.id _)
| _ _ (syn.prod_mk f g) := ⟨ff, norm_hom.prod_mk (norm_syn f).2 (norm_syn g).2⟩
| _ _ syn.inl := norm_hom.comp_inl (norm_hom.id _)
| _ _ syn.inr := norm_hom.comp_inr (norm_hom.id _)
| _ _ (syn.coprod_mk f g) := ⟨ff, norm_hom.coprod_mk (norm_syn f).2 (norm_syn g).2⟩
#exit
@[simp] theorem to_hom_comp_inl : Π {X Y Z : prod_coprod C} (f : norm_hom (sum.inl (X, Y))),
  (@norm_hom.comp_inl _ _ _ _ Z f).to_norm_hom2.to_hom = f.to_norm_hom2.to_hom ≫ inl
| (of_cat' X) _ _ f := by simp [norm_hom.comp_inl]
| (coprod W X) Y Z (norm_hom.coprod_mk f g) :=
  by ext; simp [norm_hom.comp_inl, to_hom_comp_inl f, to_hom_comp_inl g,
    ← category.assoc]
| (prod W X) Y Z (norm_hom.fst_comp f) := by simp [norm_hom.comp_inl, to_hom_comp_inl f]
| (prod W X) Y Z (norm_hom.snd_comp f) := by simp [norm_hom.comp_inl, to_hom_comp_inl f]
| (prod W X) Y Z (norm_hom.of_not_proj f) :=
  by simp [norm_hom.comp_inl, to_hom_comp_inl f.of_not_proj]

@[simp] theorem to_hom_comp_inr : Π {X Y Z : prod_coprod C} (f : norm_hom (sum.inl (X, Z))),
  (@norm_hom.comp_inr _ _ X Y Z f).to_norm_hom2.to_hom = f.to_norm_hom2.to_hom ≫ inr
| (of_cat' X) _ _ f := by simp [norm_hom.comp_inr]
| (coprod W X) Y Z (norm_hom.coprod_mk f g) :=
  by ext; simp [norm_hom.comp_inr, to_hom_comp_inr f, to_hom_comp_inr g,
    ← category.assoc]
| (prod W X) Y Z (norm_hom.fst_comp f) := by simp [norm_hom.comp_inr, to_hom_comp_inr f]
| (prod W X) Y Z (norm_hom.snd_comp f) := by simp [norm_hom.comp_inr, to_hom_comp_inr f]
| (prod W X) Y Z (norm_hom.of_not_proj f) :=
  by simp [norm_hom.comp_inr, to_hom_comp_inr f.of_not_proj]

@[simp] theorem to_hom_prod_mk : Π {X Y Z : prod_coprod C} (f : norm_hom (sum.inl (X, Y)))
  (g : norm_hom (sum.inl (X, Z))),
  (f.prod_mk g).to_norm_hom2.to_hom = prod_mk f.to_norm_hom2.to_hom g.to_norm_hom2.to_hom
| (of_cat' X) Y Z f g := by simp [norm_hom.prod_mk]
| (prod W X) Y Z (norm_hom.fst_comp f) (norm_hom.fst_comp g) :=
  by ext; simp [norm_hom.prod_mk, to_hom_prod_mk f, to_hom_prod_mk g]
| (prod W X) Y Z (norm_hom.snd_comp f) (norm_hom.snd_comp g) :=
  by ext; simp [norm_hom.prod_mk, to_hom_prod_mk f, to_hom_prod_mk g]
| (prod W X) Y Z (norm_hom.fst_comp f) (norm_hom.snd_comp g) :=
  by ext; simp [norm_hom.prod_mk, to_hom_prod_mk f, to_hom_prod_mk g]
| (prod W X) Y Z (norm_hom.snd_comp f) (norm_hom.fst_comp g) :=
  by ext; simp [norm_hom.prod_mk, to_hom_prod_mk f, to_hom_prod_mk g]
| (prod W X) Y Z (norm_hom.of_not_proj f) (norm_hom.fst_comp g) :=
  by ext; simp [norm_hom.prod_mk, to_hom_prod_mk f.of_not_proj, to_hom_prod_mk g]
| (prod W X) Y Z (norm_hom.of_not_proj f) (norm_hom.snd_comp g) :=
  by ext; simp [norm_hom.prod_mk, to_hom_prod_mk f.of_not_proj, to_hom_prod_mk g]
| (prod W X) Y Z (norm_hom.fst_comp f) (norm_hom.of_not_proj g)  :=
  by ext; simp [norm_hom.prod_mk, to_hom_prod_mk f, to_hom_prod_mk g.of_not_proj]
| (prod W X) Y Z (norm_hom.snd_comp f) (norm_hom.of_not_proj g)  :=
  by ext; simp [norm_hom.prod_mk, to_hom_prod_mk f, to_hom_prod_mk g.of_not_proj]
| (prod W X) Y Z (norm_hom.of_not_proj f) (norm_hom.of_not_proj g)  :=
  by ext; simp [norm_hom.prod_mk, to_hom_prod_mk f.of_not_proj, to_hom_prod_mk g.of_not_proj]
| (coprod W X) Y Z (norm_hom.coprod_mk f g) (norm_hom.coprod_mk h i) :=
  by ext; simp [norm_hom.prod_mk, to_hom_prod_mk f, to_hom_prod_mk g]

@[simp] theorem to_hom_comp : Π {X Y Z : prod_coprod C} (f : norm_hom2 X Y) (g : norm_hom2 Y Z),
  (f.comp g).to_hom = f.to_hom ≫ g.to_hom
| _ _ _ (norm_hom2.coprod_mk f g) h :=
  by ext; simp [to_hom_comp f, to_hom_comp g, ← category.assoc]
| _ _ _ (norm_hom2.fst_comp f) g :=
  by simp [to_hom_comp f]
| _ _ _ (norm_hom2.snd_comp f) g :=
  by simp [to_hom_comp f]
-- | _ _ _ f (norm_hom2.prod_mk g h) :=
-- | _ _ _ f (norm_hom2.comp_inl g) := g)
-- | _ _ _ f (norm_hom2.comp_inr g) :=
| _ _ _ (norm_hom2.of_cat f) (norm_hom2.of_cat g) :=
  by simp
| _ _ _ (norm_hom2.comp_inl f) (norm_hom2.coprod_mk g h) :=
  by simp [to_hom_comp f]
| _ _ _ (norm_hom2.comp_inr f) (norm_hom2.coprod_mk g h) :=
  by simp [to_hom_comp f]
| _ _ _  (norm_hom2.prod_mk f g) (norm_hom2.fst_comp h) :=
  by simp [to_hom_comp _ h, ← category.assoc]
| _ _ _  (norm_hom2.prod_mk f g) (norm_hom2.snd_comp h) :=
  by simp [to_hom_comp _ h, ← category.assoc]
--repeated cases
| _ _ _ (norm_hom2.of_cat f) (norm_hom2.comp_inl g) :=
  by simp [to_hom_comp _ g]
| _ _ _ (norm_hom2.of_cat f) (norm_hom2.comp_inr g) :=
  by simp [to_hom_comp _ g]
| _ _ _ (norm_hom2.of_cat f) (norm_hom2.prod_mk g h) :=
  by ext; simp [to_hom_comp _ g, to_hom_comp _ h]
| _ _ _ (norm_hom2.comp_inl f) (norm_hom2.comp_inl g) :=
  by simp [to_hom_comp _ g]
| _ _ _ (norm_hom2.comp_inr f) (norm_hom2.comp_inl g) :=
  by simp [to_hom_comp _ g]
| _ _ _ f'@(norm_hom2.comp_inr f) (norm_hom2.comp_inr g) :=
  by simp [to_hom_comp _ g]
| _ _ _ f'@(norm_hom2.comp_inl f) (norm_hom2.comp_inr g) :=
  by simp [to_hom_comp _ g]
| _ _ _ f'@(norm_hom2.comp_inl f) (norm_hom2.prod_mk g h) :=
  by ext; simp [to_hom_comp _ g, to_hom_comp _ h]
| _ _ _ f'@(norm_hom2.comp_inr f) (norm_hom2.prod_mk g h) :=
  by ext; simp [to_hom_comp _ g, to_hom_comp _ h]
| _ _ _ f@(norm_hom2.prod_mk _ _) (norm_hom2.comp_inl g) :=
  by simp [to_hom_comp _ g]
| _ _ _ f@(norm_hom2.prod_mk _ _) (norm_hom2.comp_inr g) :=
  by simp [to_hom_comp _ g]
| _ _ _ f@(norm_hom2.prod_mk _ _) (norm_hom2.prod_mk g h) :=
  by ext; simp [to_hom_comp _ g, to_hom_comp _ h]

#exit