import geometry.algebra.lie_group

namespace CMP_2020

section has_mul

variables {G : Type*} [has_mul G]

/-- `left_mul g` denotes left multiplication by `g` -/
@[to_additive "`left_add g` denotes left addition by `g`"]
def left_mul : G → G → G := λ g : G, λ x : G, g * x

/-- `right_mul g` denotes right multiplication by `g` -/
@[to_additive "`right_add g` denotes right addition by `g`"]
def right_mul : G → G → G := λ g : G, λ x : G, x * g

end has_mul

section times_cont_diff

variables {𝕜 : Type*} [nondiscrete_normed_field 𝕜]
{E : Type*} [normed_group E] [normed_space 𝕜 E]
{F : Type*} [normed_group F] [normed_space 𝕜 F]
{G : Type*} [normed_group G] [normed_space 𝕜 G]
{s s₁ t u : set E} {f f₁ : E → F} {g : F → G} {x : E} {c : F}
{b : E × F → G}

/--
The first projection at a point in a product is `C^∞`.
-/
lemma times_cont_diff_at_fst {p : E × F} {n : with_top ℕ} :
  times_cont_diff_at 𝕜 n (prod.fst : E × F → E) p :=
times_cont_diff_fst.times_cont_diff_at

/--
The first projection within a domain at a point in a product is `C^∞`.
-/
lemma times_cont_diff_within_at_fst {s : set (E × F)} {p : E × F} {n : with_top ℕ} :
  times_cont_diff_within_at 𝕜 n (prod.fst : E × F → E) s p :=
times_cont_diff_fst.times_cont_diff_within_at

lemma times_cont_diff_add {n : with_top ℕ} : times_cont_diff 𝕜 n (λp : F × F, p.1 + p.2) :=
begin
  apply is_bounded_linear_map.times_cont_diff,
  exact is_bounded_linear_map.add is_bounded_linear_map.fst is_bounded_linear_map.snd,
end

/-- The sum of two `C^n`functions is `C^n`. -/
lemma times_cont_diff.add {n : with_top ℕ} {f g : E → F}
  (hf : times_cont_diff 𝕜 n f) (hg : times_cont_diff 𝕜 n g) : times_cont_diff 𝕜 n (λx, f x + g x) :=
times_cont_diff_add.comp (hf.prod hg)

lemma times_cont_diff_neg {n : with_top ℕ} : times_cont_diff 𝕜 n (λp : F, -p) :=
begin
  apply is_bounded_linear_map.times_cont_diff,
  exact is_bounded_linear_map.neg is_bounded_linear_map.id
end

/-- The negative of a `C^n`function is `C^n`. -/
lemma times_cont_diff.neg {n : with_top ℕ} {f : E → F} (hf : times_cont_diff 𝕜 n f) :
  times_cont_diff 𝕜 n (λx, -f x) :=
times_cont_diff_neg.comp hf

section prod_map
variables {E' : Type*} [normed_group E'] [normed_space 𝕜 E']
{F' : Type*} [normed_group F'] [normed_space 𝕜 F']
{n : with_top ℕ}

open set

/-- The product map of two `C^n` functions within a set at a point is `C^n`
within the product set at the product point. -/
lemma times_cont_diff_within_at.prod_map'
  {s : set E} {t : set E'} {f : E → F} {g : E' → F'} {p : E × E'}
  (hf : times_cont_diff_within_at 𝕜 n f s p.1) (hg : times_cont_diff_within_at 𝕜 n g t p.2) :
  times_cont_diff_within_at 𝕜 n (prod.map f g) (set.prod s t) p :=
(hf.comp p times_cont_diff_within_at_fst (prod_subset_preimage_fst _ _)).prod
  (hg.comp p times_cont_diff_within_at_snd (prod_subset_preimage_snd _ _))

lemma times_cont_diff_within_at.prod_map
  {s : set E} {t : set E'} {f : E → F} {g : E' → F'} {x : E} {y : E'}
  (hf : times_cont_diff_within_at 𝕜 n f s x) (hg : times_cont_diff_within_at 𝕜 n g t y) :
  times_cont_diff_within_at 𝕜 n (prod.map f g) (set.prod s t) (x, y) :=
times_cont_diff_within_at.prod_map' hf hg

/-- The product map of two `C^n` functions within a set at a point is `C^n`
within the product set at the product point. -/
lemma times_cont_diff_at.prod_map {f : E → F} {g : E' → F'} {x : E} {y : E'}
  (hf : times_cont_diff_at 𝕜 n f x) (hg : times_cont_diff_at 𝕜 n g y) :
  times_cont_diff_at 𝕜 n (prod.map f g) (x, y) :=
begin
  rw times_cont_diff_at at *,
  convert hf.prod_map hg,
  simp only [univ_prod_univ]
end

/-- The product map of two `C^n` functions within a set at a point is `C^n`
within the product set at the product point. -/
lemma times_cont_diff_at.prod_map' {f : E → F} {g : E' → F'} {p : E × E'}
  (hf : times_cont_diff_at 𝕜 n f p.1) (hg : times_cont_diff_at 𝕜 n g p.2) :
  times_cont_diff_at 𝕜 n (prod.map f g) p :=
by cases p; exact times_cont_diff_at.prod_map hf hg

/-- The product map of two `C^n` functions is `C^n`. -/
lemma times_cont_diff.prod_map
  {f : E → F} {g : E' → F'}
  (hf : times_cont_diff 𝕜 n f) (hg : times_cont_diff 𝕜 n g) :
  times_cont_diff 𝕜 n (prod.map f g) :=
begin
  rw times_cont_diff_iff_times_cont_diff_at at *,
  exact λ ⟨x, y⟩, (hf x).prod_map (hg y)
end

end prod_map

end times_cont_diff

section times_cont_mdiff

variables {𝕜 : Type*} [nondiscrete_normed_field 𝕜]
-- declare a smooth manifold `M` over the pair `(E, H)`.
{E : Type*} [normed_group E] [normed_space 𝕜 E]
{H : Type*} [topological_space H] (I : model_with_corners 𝕜 E H)
{M : Type*} [topological_space M] [charted_space H M] [Is : smooth_manifold_with_corners I M]
-- declare a smooth manifold `M'` over the pair `(E', H')`.
{E' : Type*} [normed_group E'] [normed_space 𝕜 E']
{H' : Type*} [topological_space H'] (I' : model_with_corners 𝕜 E' H')
{M' : Type*} [topological_space M'] [charted_space H' M'] [I's : smooth_manifold_with_corners I' M']
-- declare a smooth manifold `N` over the pair `(F, G)`.
{F : Type*} [normed_group F] [normed_space 𝕜 F]
{G : Type*} [topological_space G] {J : model_with_corners 𝕜 F G}
{N : Type*} [topological_space N] [charted_space G N] [Js : smooth_manifold_with_corners J N]
-- declare a smooth manifold `N'` over the pair `(F', G')`.
{F' : Type*} [normed_group F'] [normed_space 𝕜 F']
{G' : Type*} [topological_space G'] {J' : model_with_corners 𝕜 F' G'}
{N' : Type*} [topological_space N'] [charted_space G' N'] [J's : smooth_manifold_with_corners J' N']
-- declare functions, sets, points and smoothness indices
{f f₁ : M → M'} {s s₁ t : set M} {x : M} {m n : with_top ℕ}

/-! ### Smoothness of standard maps associated to the product of manifolds -/

section prod_mk

lemma times_cont_mdiff_within_at.prod_mk {f : M → M'} {g : M → N'}
  (hf : times_cont_mdiff_within_at I I' n f s x) (hg : times_cont_mdiff_within_at I J' n g s x) :
  times_cont_mdiff_within_at I (I'.prod J') n (λ x, (f x, g x)) s x :=
begin
  rw times_cont_mdiff_within_at_iff at *,
  refine ⟨hf.1.prod hg.1, (hf.2.mono _).prod (hg.2.mono _)⟩;
  mfld_set_tac,
end

lemma times_cont_mdiff_at.prod_mk {f : M → M'} {g : M → N'}
  (hf : times_cont_mdiff_at I I' n f x) (hg : times_cont_mdiff_at I J' n g x) :
  times_cont_mdiff_at I (I'.prod J') n (λ x, (f x, g x)) x :=
hf.prod_mk hg

lemma times_cont_mdiff_on.prod_mk {f : M → M'} {g : M → N'}
  (hf : times_cont_mdiff_on I I' n f s) (hg : times_cont_mdiff_on I J' n g s) :
  times_cont_mdiff_on I (I'.prod J') n (λ x, (f x, g x)) s :=
λ x hx, (hf x hx).prod_mk (hg x hx)

lemma times_cont_mdiff.prod_mk {f : M → M'} {g : M → N'}
  (hf : times_cont_mdiff I I' n f) (hg : times_cont_mdiff I J' n g) :
  times_cont_mdiff I (I'.prod J') n (λ x, (f x, g x)) :=
λ x, (hf x).prod_mk (hg x)

lemma smooth_within_at.prod_mk {f : M → M'} {g : M → N'}
  (hf : smooth_within_at I I' f s x) (hg : smooth_within_at I J' g s x) :
  smooth_within_at I (I'.prod J') (λ x, (f x, g x)) s x :=
hf.prod_mk hg

lemma smooth_at.prod_mk {f : M → M'} {g : M → N'}
  (hf : smooth_at I I' f x) (hg : smooth_at I J' g x) :
  smooth_at I (I'.prod J') (λ x, (f x, g x)) x :=
hf.prod_mk hg

lemma smooth_on.prod_mk {f : M → M'} {g : M → N'}
  (hf : smooth_on I I' f s) (hg : smooth_on I J' g s) :
  smooth_on I (I'.prod J') (λ x, (f x, g x)) s :=
hf.prod_mk hg

lemma smooth.prod_mk {f : M → M'} {g : M → N'}
  (hf : smooth I I' f) (hg : smooth I J' g) :
  smooth I (I'.prod J') (λ x, (f x, g x)) :=
hf.prod_mk hg

end prod_mk

section projections

lemma times_cont_mdiff_within_at_fst {s : set (M × N)} {p : M × N} :
  times_cont_mdiff_within_at (I.prod J) I n prod.fst s p :=
begin
  rw times_cont_mdiff_within_at_iff,
  refine ⟨continuous_within_at_fst, _⟩,
  refine times_cont_diff_within_at_fst.congr (λ y hy, _) _,
  { simp only with mfld_simps at hy,
    simp only [hy] with mfld_simps },
  { simp only with mfld_simps }
end

lemma times_cont_mdiff_at_fst {p : M × N} :
  times_cont_mdiff_at (I.prod J) I n prod.fst p :=
times_cont_mdiff_within_at_fst

lemma times_cont_mdiff_on_fst {s : set (M × N)} :
  times_cont_mdiff_on (I.prod J) I n prod.fst s :=
λ x hx, times_cont_mdiff_within_at_fst

lemma times_cont_mdiff_fst :
  times_cont_mdiff (I.prod J) I n (@prod.fst M N) :=
λ x, times_cont_mdiff_at_fst

lemma smooth_within_at_fst {s : set (M × N)} {p : M × N} :
  smooth_within_at (I.prod J) I prod.fst s p :=
times_cont_mdiff_within_at_fst

lemma smooth_at_fst {p : M × N} :
  smooth_at (I.prod J) I prod.fst p :=
times_cont_mdiff_at_fst

lemma smooth_on_fst {s : set (M × N)} :
  smooth_on (I.prod J) I prod.fst s :=
times_cont_mdiff_on_fst

lemma smooth_fst :
  smooth (I.prod J) I (@prod.fst M N) :=
times_cont_mdiff_fst

lemma times_cont_mdiff_within_at_snd {s : set (M × N)} {p : M × N} :
  times_cont_mdiff_within_at (I.prod J) J n prod.snd s p :=
begin
  rw times_cont_mdiff_within_at_iff,
  refine ⟨continuous_within_at_snd, _⟩,
  refine times_cont_diff_within_at_snd.congr (λ y hy, _) _,
  { simp only with mfld_simps at hy,
    simp only [hy] with mfld_simps },
  { simp only with mfld_simps }
end

lemma times_cont_mdiff_at_snd {p : M × N} :
  times_cont_mdiff_at (I.prod J) J n prod.snd p :=
times_cont_mdiff_within_at_snd

lemma times_cont_mdiff_on_snd {s : set (M × N)} :
  times_cont_mdiff_on (I.prod J) J n prod.snd s :=
λ x hx, times_cont_mdiff_within_at_snd

lemma times_cont_mdiff_snd :
  times_cont_mdiff (I.prod J) J n (@prod.snd M N) :=
λ x, times_cont_mdiff_at_snd

lemma smooth_within_at_snd {s : set (M × N)} {p : M × N} :
  smooth_within_at (I.prod J) J prod.snd s p :=
times_cont_mdiff_within_at_snd

lemma smooth_at_snd {p : M × N} :
  smooth_at (I.prod J) J prod.snd p :=
times_cont_mdiff_at_snd

lemma smooth_on_snd {s : set (M × N)} :
  smooth_on (I.prod J) J prod.snd s :=
times_cont_mdiff_on_snd

lemma smooth_snd :
  smooth (I.prod J) J (@prod.snd M N) :=
times_cont_mdiff_snd

include Is I's J's

lemma smooth_iff_proj_smooth {f : M → M' × N'} :
  (smooth I (I'.prod J') f) ↔ (smooth I I' (prod.fst ∘ f)) ∧ (smooth I J' (prod.snd ∘ f)) :=
begin
  split,
  { intro h, exact ⟨smooth_fst.comp h, smooth_snd.comp h⟩ },
  { rintro ⟨h_fst, h_snd⟩, simpa only [prod.mk.eta] using h_fst.prod_mk h_snd, }
end

end projections

section prod_map

variables {g : N → N'} {r : set N} {y : N}
include Is I's Js J's

/-- The product map of two `C^n` functions within a set at a point is `C^n`
within the product set at the product point. -/
lemma times_cont_mdiff_within_at.prod_map' {p : M × N}
  (hf : times_cont_mdiff_within_at I I' n f s p.1) (hg : times_cont_mdiff_within_at J J' n g r p.2) :
  times_cont_mdiff_within_at (I.prod J) (I'.prod J') n (prod.map f g) (s.prod r) p :=
(hf.comp p times_cont_mdiff_within_at_fst (prod_subset_preimage_fst _ _)).prod_mk $
hg.comp p times_cont_mdiff_within_at_snd (prod_subset_preimage_snd _ _)

lemma times_cont_mdiff_within_at.prod_map
  (hf : times_cont_mdiff_within_at I I' n f s x) (hg : times_cont_mdiff_within_at J J' n g r y) :
  times_cont_mdiff_within_at (I.prod J) (I'.prod J') n (prod.map f g) (s.prod r) (x, y) :=
times_cont_mdiff_within_at.prod_map' hf hg

lemma times_cont_mdiff_at.prod_map
  (hf : times_cont_mdiff_at I I' n f x) (hg : times_cont_mdiff_at J J' n g y) :
  times_cont_mdiff_at (I.prod J) (I'.prod J') n (prod.map f g) (x, y) :=
begin
  rw ← times_cont_mdiff_within_at_univ at *,
  convert hf.prod_map hg,
  exact univ_prod_univ.symm
end

lemma times_cont_mdiff_at.prod_map' {p : M × N}
  (hf : times_cont_mdiff_at I I' n f p.1) (hg : times_cont_mdiff_at J J' n g p.2) :
  times_cont_mdiff_at (I.prod J) (I'.prod J') n (prod.map f g) p :=
begin
  rcases p,
  exact hf.prod_map hg
end

lemma times_cont_mdiff_on.prod_map
  (hf : times_cont_mdiff_on I I' n f s) (hg : times_cont_mdiff_on J J' n g r) :
  times_cont_mdiff_on (I.prod J) (I'.prod J') n (prod.map f g) (s.prod r) :=
(hf.comp times_cont_mdiff_on_fst (prod_subset_preimage_fst _ _)).prod_mk $
hg.comp (times_cont_mdiff_on_snd) (prod_subset_preimage_snd _ _)

lemma times_cont_mdiff.prod_map
  (hf : times_cont_mdiff I I' n f) (hg : times_cont_mdiff J J' n g) :
  times_cont_mdiff (I.prod J) (I'.prod J') n (prod.map f g) :=
begin
  assume p,
  exact (hf p.1).prod_map' (hg p.2)
end

lemma smooth_within_at.prod_map
  (hf : smooth_within_at I I' f s x) (hg : smooth_within_at J J' g r y) :
  smooth_within_at (I.prod J) (I'.prod J') (prod.map f g) (s.prod r) (x, y) :=
hf.prod_map hg

lemma smooth_at.prod_map
  (hf : smooth_at I I' f x) (hg : smooth_at J J' g y) :
  smooth_at (I.prod J) (I'.prod J') (prod.map f g) (x, y) :=
hf.prod_map hg

lemma smooth_on.prod_map
  (hf : smooth_on I I' f s) (hg : smooth_on J J' g r) :
  smooth_on (I.prod J) (I'.prod J') (prod.map f g) (s.prod r) :=
hf.prod_map hg

lemma smooth.prod_map
  (hf : smooth I I' f) (hg : smooth J J' g) :
  smooth (I.prod J) (I'.prod J') (prod.map f g) :=
hf.prod_map hg

end prod_map

end times_cont_mdiff

section lie_group

/-
Copyright © 2020 Nicolò Cavalleri. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Nicolò Cavalleri.
-/

/-!
# Lie groups
A Lie group is a group that is also a smooth manifold, in which the group operations of
multiplication and inversion are smooth maps. Smoothness of the group multiplication means that
This conversation was marked as resolved by Nicknamen
multiplication is a smooth mapping of the product manifold `G` × `G` into `G`.
Note that, since a manifold here is not second-countable and Hausdorff a Lie group here is not
guaranteed to be second-countable (even though it can be proved it is Hausdorff). Note also that Lie
groups here are not necessarily finite dimensional.
## Main definitions and statements
* `lie_add_group I G` : a Lie additive group where `G` is a manifold on the model with corners `I`.
* `lie_group I G`     : a Lie multiplicative group where `G` is a manifold on the model with
                        corners `I`.
* `lie_add_group_morphism I I' G G'`  : morphism of addittive Lie groups
* `lie_group_morphism I I' G G'`      : morphism of Lie groups
* `lie_add_group_core I G`            : allows to define a Lie additive group without first proving
                                        it is a topological additive group.
* `lie_group_core I G`                : allows to define a Lie group without first proving
                                        it is a topological group.
* `reals_lie_group`                   : real numbers are a Lie group
## Implementation notes
A priori, a Lie group here is a manifold with corners.
The definition of Lie group cannot require `I : model_with_corners 𝕜 E E` with the same space as the
model space and as the model vector space, as one might hope, beause in the product situation,
the model space is `model_prod E E'` and the model vector space is `E × E'`, which are not the same,
so the definition does not apply. Hence the definition should be more general, allowing
`I : model_with_corners 𝕜 E H`.
-/

noncomputable theory

section lie_group

set_option default_priority 100

/-- A Lie (additive) group is a group and a smooth manifold at the same time in which
the addition and negation operations are smooth. -/
class lie_add_group {𝕜 : Type*} [nondiscrete_normed_field 𝕜]
  {H : Type*} [topological_space H]
  {E : Type*} [normed_group E] [normed_space 𝕜 E] (I : model_with_corners 𝕜 E H)
  (G : Type*) [add_group G] [topological_space G] [topological_add_group G] [charted_space H G]
  extends smooth_manifold_with_corners I G : Prop :=
(smooth_add : smooth (I.prod I) I (λ p : G×G, p.1 + p.2))
(smooth_neg : smooth I I (λ a:G, -a))

/-- A Lie group is a group and a smooth manifold at the same time in which
the multiplication and inverse operations are smooth. -/
@[to_additive]
class lie_group {𝕜 : Type*} [nondiscrete_normed_field 𝕜]
  {H : Type*} [topological_space H]
  {E : Type*} [normed_group E] [normed_space 𝕜 E] (I : model_with_corners 𝕜 E H)
  (G : Type*) [group G] [topological_space G] [topological_group G] [charted_space H G]
  extends smooth_manifold_with_corners I G : Prop :=
(smooth_mul : smooth (I.prod I) I (λ p : G×G, p.1 * p.2))
(smooth_inv : smooth I I (λ a:G, a⁻¹))

section lie_group

variables {𝕜 : Type*} [nondiscrete_normed_field 𝕜]
{H : Type*} [topological_space H]
{E : Type*} [normed_group E] [normed_space 𝕜 E] {I : model_with_corners 𝕜 E H}
{F : Type*} [normed_group F] [normed_space 𝕜 F] {J : model_with_corners 𝕜 F F}
{G : Type*} [topological_space G] [charted_space H G] [group G]
[topological_group G] [lie_group I G]
{E' : Type*} [normed_group E'] [normed_space 𝕜 E']
{H' : Type*} [topological_space H'] {I' : model_with_corners 𝕜 E' H'}
{M : Type*} [topological_space M] [charted_space H' M] [smooth_manifold_with_corners I' M]
{E'' : Type*} [normed_group E''] [normed_space 𝕜 E'']
{H'' : Type*} [topological_space H''] {I'' : model_with_corners 𝕜 E'' H''}
{M' : Type*} [topological_space M'] [charted_space H'' M'] [smooth_manifold_with_corners I'' M']

@[to_additive]
lemma smooth_mul : smooth (I.prod I) I (λ p : G×G, p.1 * p.2) :=
lie_group.smooth_mul

@[to_additive]
lemma smooth.mul {f : M → G} {g : M → G} (hf : smooth I' I f) (hg : smooth I' I g) :
  smooth I' I (f * g) :=
smooth_mul.comp (hf.prod_mk hg)

localized "notation `L_add` := left_add" in lie_group

localized "notation `R_add` := right_add" in lie_group

localized "notation `L` := left_mul" in lie_group

localized "notation `R` := right_mul" in lie_group

@[to_additive]
lemma smooth_left_mul {a : G} : smooth I I (left_mul a) :=
smooth_mul.comp (smooth_const.prod_mk smooth_id)

@[to_additive]
lemma smooth_right_mul {a : G} : smooth I I (right_mul a) :=
smooth_mul.comp (smooth_id.prod_mk smooth_const)

@[to_additive]
lemma smooth_on.mul {f : M → G} {g : M → G} {s : set M}
  (hf : smooth_on I' I f s) (hg : smooth_on I' I g s) :
  smooth_on I' I (f * g) s :=
(smooth_mul.comp_smooth_on (hf.prod_mk hg) : _)

lemma smooth_pow : ∀ n : ℕ, smooth I I (λ a : G, a ^ n)
| 0 := by { simp only [pow_zero], exact smooth_const }
| (k+1) := show smooth I I (λ (a : G), a * a ^ k), from smooth_id.mul (smooth_pow _)

@[to_additive]
lemma smooth_inv : smooth I I (λ x : G, x⁻¹) :=
lie_group.smooth_inv

@[to_additive]
lemma smooth.inv {f : M → G}
  (hf : smooth I' I f) : smooth I' I (λx, (f x)⁻¹) :=
smooth_inv.comp hf

@[to_additive]
lemma smooth_on.inv {f : M → G} {s : set M}
  (hf : smooth_on I' I f s) : smooth_on I' I (λx, (f x)⁻¹) s :=
smooth_inv.comp_smooth_on hf

end lie_group

section prod_lie_group

/- Instance of product group -/
@[to_additive]
instance {𝕜 : Type*} [nondiscrete_normed_field 𝕜] {H : Type*} [topological_space H]
  {E : Type*} [normed_group E] [normed_space 𝕜 E]  {I : model_with_corners 𝕜 E H}
  {G : Type*} [topological_space G] [charted_space H G] [group G] [topological_group G]
  [h : lie_group I G] {E' : Type*} [normed_group E'] [normed_space 𝕜 E']
  {H' : Type*} [topological_space H'] {I' : model_with_corners 𝕜 E' H'}
  {G' : Type*} [topological_space G'] [charted_space H' G']
  [group G'] [topological_group G'] [h' : lie_group I' G'] : lie_group (I.prod I') (G×G') :=
{ smooth_mul := ((smooth_fst.comp smooth_fst).smooth.mul (smooth_fst.comp smooth_snd)).prod_mk
    ((smooth_snd.comp smooth_fst).smooth.mul (smooth_snd.comp smooth_snd)),
  smooth_inv := smooth_fst.inv.prod_mk smooth_snd.inv, }

end prod_lie_group

section lie_add_group_morphism

variables {𝕜 : Type*} [nondiscrete_normed_field 𝕜]
{E : Type*} [normed_group E] [normed_space 𝕜 E]
{E' : Type*} [normed_group E'] [normed_space 𝕜 E']

/-- Morphism of additive Lie groups. -/
structure lie_add_group_morphism (I : model_with_corners 𝕜 E E) (I' : model_with_corners 𝕜 E' E')
  (G : Type*) [topological_space G] [charted_space E G] [smooth_manifold_with_corners I G]
  [add_group G] [topological_add_group G] [lie_add_group I G]
  (G' : Type*) [topological_space G'] [charted_space E' G'] [smooth_manifold_with_corners I' G']
  [add_group G'] [topological_add_group G'] [lie_add_group I' G'] extends add_monoid_hom G G' :=
(smooth_to_fun : smooth I I' to_fun)

/-- Morphism of Lie groups. -/
@[to_additive]
structure lie_group_morphism (I : model_with_corners 𝕜 E E) (I' : model_with_corners 𝕜 E' E')
  (G : Type*) [topological_space G] [charted_space E G] [smooth_manifold_with_corners I G] [group G]
  [topological_group G] [lie_group I G]
  (G' : Type*) [topological_space G'] [charted_space E' G'] [smooth_manifold_with_corners I' G']
  [group G'] [topological_group G'] [lie_group I' G'] extends monoid_hom G G' :=
(smooth_to_fun : smooth I I' to_fun)

variables {I : model_with_corners 𝕜 E E} {I' : model_with_corners 𝕜 E' E'}
{G : Type*} [topological_space G] [charted_space E G] [smooth_manifold_with_corners I G]
[group G] [topological_group G] [lie_group I G]
{G' : Type*} [topological_space G'] [charted_space E' G'] [smooth_manifold_with_corners I' G']
[group G'] [topological_group G'] [lie_group I' G']

@[to_additive]
instance : has_one (lie_group_morphism I I' G G') := ⟨⟨1, smooth_const⟩⟩
This conversation was marked as resolved by sgouezel

@[to_additive]
instance : inhabited (lie_group_morphism I I' G G') := ⟨1⟩

@[to_additive]
instance : has_coe_to_fun (lie_group_morphism I I' G G') := ⟨_, λ a, a.to_fun⟩

end lie_add_group_morphism

end lie_group

section lie_group_core

/-- Sometimes one might want to define a Lie additive group `G` without having proved previously
that `G` is a topological additive group. In such case it is possible to use `lie_add_group_core`
that does not require such instance, and then get a Lie group by invoking `to_lie_add_group`. -/
structure lie_add_group_core {𝕜 : Type*} [nondiscrete_normed_field 𝕜]
  {E : Type*} [normed_group E]
  [normed_space 𝕜 E] (I : model_with_corners 𝕜 E E)
  (G : Type*) [add_group G] [topological_space G]
  [charted_space E G] [smooth_manifold_with_corners I G] : Prop :=
(smooth_add : smooth (I.prod I) I (λ p : G×G, p.1 + p.2))
(smooth_neg : smooth I I (λ a:G, -a))

/-- Sometimes one might want to define a Lie group `G` without having proved previously that `G` is
a topological group. In such case it is possible to use `lie_group_core` that does not require such
instance, and then get a Lie group by invoking `to_lie_group` defined below. -/
@[to_additive]
structure lie_group_core {𝕜 : Type*} [nondiscrete_normed_field 𝕜]
  {E : Type*} [normed_group E]
  [normed_space 𝕜 E] (I : model_with_corners 𝕜 E E)
  (G : Type*) [group G] [topological_space G]
  [charted_space E G] [smooth_manifold_with_corners I G] : Prop :=
(smooth_mul : smooth (I.prod I) I (λ p : G×G, p.1 * p.2))
(smooth_inv : smooth I I (λ a:G, a⁻¹))

variables {𝕜 : Type*} [nondiscrete_normed_field 𝕜]
{E : Type*} [normed_group E] [normed_space 𝕜 E] {I : model_with_corners 𝕜 E E}
{F : Type*} [normed_group F] [normed_space 𝕜 F] {J : model_with_corners 𝕜 F F}
{G : Type*} [topological_space G] [charted_space E G] [smooth_manifold_with_corners I G] [group G]

namespace lie_group_core

variables (c : lie_group_core I G)

@[to_additive]
protected lemma to_topological_group : topological_group G :=
{ continuous_mul := c.smooth_mul.continuous,
  continuous_inv := c.smooth_inv.continuous, }

@[to_additive]
protected lemma to_lie_group : @lie_group 𝕜 _ _ _ E _ _ I G _ _ c.to_topological_group _ :=
{ smooth_mul := c.smooth_mul,
  smooth_inv := c.smooth_inv, }

end lie_group_core

end lie_group_core

/-! ### Real numbers are a Lie group -/

section real_numbers_lie_group

instance normed_group_lie_group {𝕜 : Type*} [nondiscrete_normed_field 𝕜]
{E : Type*} [normed_group E] [normed_space 𝕜 E] :
lie_add_group (model_with_corners_self 𝕜 E) E :=
{ smooth_add :=
  begin
    rw smooth_iff,
    refine ⟨continuous_add, λ x y, _⟩,
    simp only [prod.mk.eta] with mfld_simps,
    rw times_cont_diff_on_univ,
    exact times_cont_diff_add,
  end,
  smooth_neg :=
  begin
    rw smooth_iff,
    refine ⟨continuous_neg, λ x y, _⟩,
    simp only [prod.mk.eta] with mfld_simps,
    rw times_cont_diff_on_univ,
    exact times_cont_diff_neg,
  end }

instance reals_lie_group : lie_add_group (model_with_corners_self ℝ ℝ) ℝ := by apply_instance

end real_numbers_lie_group

end lie_group

end CMP_2020


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

! This file was ported from Lean 3 source module control.monad.basic
! leanprover-community/mathlib commit 70d50ecfd4900dd6d328da39ab7ebd516abe4025
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Logic.Equiv.Defs
import Mathlib.Control.SimpSet

/-!
# Monad

## Attributes

 * ext
 * functor_norm
 * monad_norm

## Implementation Details

Set of rewrite rules and automation for monads in general and
`ReaderT`, `StateT`, `ExceptT` and `OptionT` in particular.

The rewrite rules for monads are carefully chosen so that `simp with
functor_norm` will not introduce monadic vocabulary in a context where
applicatives would do just fine but will handle monadic notation
already present in an expression.

In a context where monadic reasoning is desired `simp with monad_norm`
will translate functor and applicative notation into monad notation
and use regular `functor_norm` rules as well.

## Tags

functor, applicative, monad, simp

-/

attribute [ext] ReaderT.ext StateT.ext ExceptT.ext Option.ext

attribute [functor_norm] bind_assoc pure_bind bind_pure

attribute [monad_norm] seq_eq_bind_map

@[monad_norm]
theorem map_eq_bind_pure_comp (m : Type u → Type v) [Monad m] [LawfulMonad m]
    (f : α → β) (x : m α) : f <$> x = x >>= pure ∘ f :=
  (bind_pure_comp f x).symm
#align map_eq_bind_pure_comp map_eq_bind_pure_comp

/-- run a `StateT` program and discard the final state -/
def StateT.eval {m : Type u → Type v} [Functor m] (cmd : StateT σ m α) (s : σ) : m α :=
  Prod.fst <$> cmd.run s
#align state_t.eval StateT.eval

/-- reduce the equivalence between two state monads to the equivalence between
their respective function spaces -/
def StateT.equiv {m₁ : Type u₀ → Type v₀} {m₂ : Type u₁ → Type v₁}
    (F : (σ₁ → m₁ (α₁ × σ₁)) ≃ (σ₂ → m₂ (α₂ × σ₂))) : StateT σ₁ m₁ α₁ ≃ StateT σ₂ m₂ α₂ :=
  F
#align state_t.equiv StateT.equiv

/-- reduce the equivalence between two reader monads to the equivalence between
their respective function spaces -/
def ReaderT.equiv {m₁ : Type u₀ → Type v₀} {m₂ : Type u₁ → Type v₁}
    (F : (ρ₁ → m₁ α₁) ≃ (ρ₂ → m₂ α₂)) : ReaderT ρ₁ m₁ α₁ ≃ ReaderT ρ₂ m₂ α₂ :=
  F
#align reader_t.equiv ReaderT.equiv


/-
Copyright © 2019, Oracle and/or its affiliates. All rights reserved.
-/

import data.set
import analysis.complex.exponential
import .attributed.dvector
import lib.basic
import topology.constructions

local attribute [instance] classical.prop_decidable

open nnreal real ennreal set lattice
open topological_space
open measure_theory

lemma lc_nnreal:
  ∀ a: nnreal, ∀ b: nnreal, a + b = 1 → a = (1:nnreal) - b :=
assume a b h, h ▸ (nnreal.add_sub_cancel).symm

lemma delta_helper:
  ∀ δ: nnreal, δ > (0:nnreal) → (1:nnreal) - δ ≤ (1: nnreal) :=
assume h, by simp

lemma coe_pmeas:
  ∀ a: ennreal, ∀ b: ennreal, a ≤ (1:ennreal) → b ≤ (1: ennreal) → a ≤ b → ennreal.to_nnreal a ≤ ennreal.to_nnreal b :=
begin
  intros a b h₁ h₂ h₃,
  rw [← coe_le_coe, coe_to_nnreal,coe_to_nnreal],
  assumption,
  rw ←ennreal.lt_top_iff_ne_top,
  exact lt_of_le_of_lt h₂ (ennreal.lt_top_iff_ne_top.2 one_ne_top),
  rw ←ennreal.lt_top_iff_ne_top,
  exact lt_of_le_of_lt h₁ (ennreal.lt_top_iff_ne_top.2 one_ne_top),
end

lemma pow_preserves_order:
  ∀ n: ℕ, ∀ a: nnreal, ∀ b: nnreal, a ≤ b → a^n ≤ b^n :=
begin
  intros n a b h,
  induction n with k ih ; try {simp},
  simp [pow_succ], exact mul_le_mul h ih (zero_le _) (zero_le _),
end

lemma not_eq_prop:
  ∀ A: Prop, ∀ B: Prop, (¬ (A ↔ B)) ↔ ((¬ (A → B)) ∨ (¬ (B → A))) :=
begin
  intros,
  split; intros; try {finish},
end

lemma nnreal_sub_trans:
  ∀ a: nnreal, ∀ b: nnreal,
  a ≥ b → 1 - a ≤ 1 - b :=
begin
intros,
rw nnreal.sub_le_iff_le_add,
simp,
by_cases (b ≤ 1),
{
  have h: 1 + (a - b) = a + (1 - b),
  by calc 1 + (a - b) = 1 + a - b   : by rw [←nnreal.eq_iff,nnreal.coe_add, (nnreal.coe_sub _ _ a_1), ←add_sub_assoc, nnreal.coe_sub _, nnreal.coe_add]; exact le_add_of_le_of_nonneg h (zero_le _)
        ...     = a + 1 - b   : by rw add_comm
        ...     = a + (1 - b) : by rw [←nnreal.eq_iff,nnreal.coe_add, (nnreal.coe_sub _ _ h), ←add_sub_assoc,nnreal.coe_sub _, nnreal.coe_add];exact le_add_of_le_of_nonneg a_1 (zero_le _),
  rw h.symm,
  cases b, cases a, dsimp at *, simp at *,
},
{
  simp at h,
  rw nnreal.sub_eq_zero, swap,
  exact le_of_lt h,
  simp,
  transitivity b,
  exact le_of_lt h,
  assumption,
}
end

lemma prod_rw {α: Type} {β: Type}:
  ∀ P₁: α → Prop,
  ∀ P₂: β → Prop,
  { v : α × β | P₁ v.fst ∧ P₂ v.snd} = set.prod {x: α | P₁ x} {x: β | P₂ x} :=
begin
  intros,
  unfold set.prod,
  rw ext_iff, intro,
  repeat {rw mem_set_of_eq},
end

lemma dfin_1_projn {α: Type}:
  ∀ P: α → Prop,
  ∀ x: vec α 0,
  (∀ (i: dfin 1), P (kth_projn x i)) ↔ P x :=
begin
  intros,
  split; intros ; try {simpa},
  simp at *, apply a,
  exact dfin.fz,
end

lemma dfin_1_projn' {α: Type}:
  ∀ P: α → Prop,
  { x: vec α 0 | ∀ (i: dfin 1), P (kth_projn x i)} = {x: α | P x} :=
begin
  intros,
  rw ext_iff, intro,
  repeat {rw mem_set_of_eq},
  rw dfin_1_projn,
  trivial,
end

lemma is_measurable_simple_vec {α: Type} [measurable_space α]:
  ∀ P: α → Prop,
  is_measurable {x: α | P x} →
  ∀ n,
  is_measurable {v: vec α n | ∀ (i: dfin (nat.succ n)), P(kth_projn v i)} :=
begin
  intros,
  induction n; intros; try{rwa dfin_1_projn'},
  dunfold vec,
  conv { congr, congr, funext, rw dfin_succ_prop_iff_fst_and_rst, skip,},
  have PROD := prod_rw (λ x, P x) (λ x, ∀ (i: dfin (nat.succ n_n)), P(kth_projn x i)),
  simp at PROD,
  rw PROD, clear PROD,
  apply is_measurable_set_prod; try {assumption},
end

/- Move these results back to where vec was defined (../to_mathlib.lean)-/
noncomputable
instance vec_topo: ∀ n: ℕ, topological_space (vec nnreal n) :=
begin
  intro,
  induction n ; try{ dunfold vec, apply_instance},
  unfold vec,
  have PROD := @prod.topological_space nnreal (vec nnreal n_n) _ n_ih,
  assumption,
end

instance vec_second_countable : ∀ n:ℕ, second_countable_topology (vec nnreal n) :=
begin
  intros n,
  induction n with k ih,
  dsimp [vec], apply_instance,
  dsimp [vec],
  haveI := second_countable_topology nnreal,
  apply_instance,
end

lemma vec.measurable_space_eq_borel (n : ℕ) : vec.measurable_space n = measure_theory.borel (vec nnreal n) :=
begin
  induction n with k ih,
  refl,
  dsimp [vec], rw ←measure_theory.borel_prod,
  rw prod.measurable_space, rw ←ih, refl,
end

lemma is_measurable_of_continuous_vec :
  ∀ n: ℕ,
  ∀ f: nnreal × vec nnreal n → nnreal,
  ∀ g: nnreal × vec nnreal n → nnreal,
  continuous f →
  continuous g →
  is_measurable {p: nnreal × (vec nnreal n) | f p < g p} :=
begin
  intros n f g hf hg,
  convert measure_theory.is_measurable_of_is_open _,
  haveI := vec_second_countable n,
  swap,
  change topological_space (vec nnreal (nat.succ n)), apply_instance,
  swap,
  exact is_open_lt hf hg, rw prod.measurable_space,
  rw ←measure_theory.borel_prod, rw vec.measurable_space_eq_borel n, refl,
end

lemma to_nnreal_sub {r₁ r₂ : ennreal} (h₁ : r₁ < ⊤) (h₂ : r₂ < ⊤) :
  (r₁ - r₂).to_nnreal = r₁.to_nnreal - r₂.to_nnreal :=
by rw [← ennreal.coe_eq_coe, ennreal.coe_sub, ennreal.coe_to_nnreal (ne_top_of_lt h₂), ennreal.coe_to_nnreal (ne_top_of_lt h₁),
  ennreal.coe_to_nnreal ((lt_top_iff_ne_top.1 (lt_of_le_of_lt (sub_le_self _ _) h₁)))]

section to_borel_space

/- Move these back to borel_space.lean -/

variables {α : Type*} [linear_order α] [topological_space α] [ordered_topology α] {a b c : α}

lemma is_measurable_Ioc : is_measurable (Ioc a b) :=  (is_measurable_of_is_open (is_open_lt continuous_const continuous_id)).inter (is_measurable_of_is_closed (is_closed_le continuous_id continuous_const))

lemma is_measurable_Icc : is_measurable (Icc a b) := is_measurable_of_is_closed $ is_closed_Icc

lemma is_measurable_Ioi : is_measurable (Ioi a) :=
is_measurable_of_is_open $ is_open_lt continuous_const continuous_id

end to_borel_space

lemma Ioi_complement:
  ∀ x: nnreal, Ioi x = - (Iio x ∪ {x}) :=
begin
  intros,
  rw ext_iff, intro,
  unfold Ioi, unfold Iio,
  simp only [mem_set_of_eq, mem_insert_iff, union_singleton, mem_compl_eq],
  repeat {rw mem_set_of_eq},
  split; intro,
  {
    push_neg, refine and.intro _ (le_of_lt a),
    by_contradiction, simp at *,
    rw a_1 at a,
    have FOO: ¬ (x < x), simp,
    contradiction,
  },
  {
    push_neg at a,
    cases a,
    by_contradiction,
    have FOO: ¬ (x ≤ x_1),by simp at * ; exact lt_of_le_of_ne a a_left,
    contradiction,
  },
end

lemma Icc_diff_Ioc:
  ∀ a: nnreal, ∀ b: nnreal, ∀ c: nnreal,
  a ≤ b → b ≤ c → (Icc a c \ Icc a b) = Ioc b c :=
begin
  unfold Icc, unfold Ioc,
  introv H1 H2,
  rw ext_iff, intro,
  rw mem_diff,
  repeat {rw mem_set_of_eq at *,},
  split; intros,
  {cases a_1, cases a_1_left, finish,},
  {cases a_1, refine and.intro _ (by exact (not_and.2 (λ a, not_le.2 a_1_left))),
  {
  split ; try {assumption},
  transitivity b,
  assumption,
  exact le_of_lt a_1_left,
  },
  },
end

lemma mono_simple {μ: probability_measure nnreal}:
  ∀ a: nnreal, ∀ b: nnreal, a ≤ b → μ (Icc 0 a) ≤ μ (Icc 0 b) :=
begin
  intros,
  apply probability_measure.prob_mono,
  unfold Icc,
  rw subset_def, intros,
  rw mem_set_of_eq at *,
  cases a_2,
  split,
  assumption,
  transitivity a; assumption,
end

lemma log_le_log_nnreal:
  ∀ x: nnreal, ∀ y: nnreal, x > 0 → y > 0 → (x ≤ y ↔ log x ≤ log y) :=
begin
  intros,
  rw log_le_log,
  refl, assumption, assumption,
end

lemma log_pow_nnreal:
  ∀ x: nnreal, x > 0 → ∀ n: ℕ, log(x^n) = n * log(x) :=
begin
  intros,
  apply exp_injective,
  rw exp_nat_mul,
  rw exp_log,
  rw exp_log,
  assumption,
  exact pow_pos a n,
end

lemma pow_coe:
  ∀ a: nnreal, ∀ n: ℕ, a.val ^ n = (a ^ n).val :=
begin
  intros,
  induction n,
  simp, refl,
  have pow_nnreal: ∀ a: nnreal, ∀ n: ℕ, a ^ (nat.succ n) = a * a ^ n, intros, exact rfl,
  rw pow_nnreal,
  have mul_coe: ∀ a: nnreal, ∀ b: nnreal, (a * b).val = a.val * b.val, intros, refl,
  rw mul_coe,
  rw ← n_ih,
  refl,
end

lemma sub_nnreal:
  ∀ a: nnreal, ∀ b: nnreal, a ≥ b → (a - b).val = a.val - b.val :=
begin
  intros a b h,
  change (↑(a-b) = ↑a - ↑b),
  rw nnreal.coe_sub _ _ h,
end

lemma ite_equals_union_interval:
  ∀ θ > 0, ∀ y: nnreal, {x: nnreal | ite (to_bool(x ≤ y)) x 0 < θ} = Ico 0 θ ∪ Ioi y :=
begin
  intros,
  unfold Ico, unfold Ioi,
  rw ext_iff, intro,
  rw mem_union,
  repeat {rw mem_set_of_eq},
  split; intro,
  {
    split_ifs at a,
    {left, split, tidy,},
    {right, tidy,},
  },
  {
    cases a,
    {cases a, split_ifs; assumption,},
    {
    split_ifs ; try {assumption},
    {by_contradiction,
    have GEQ: ¬ (y < x), by simp at h ⊢ ; assumption,
    contradiction,},
    },
  },
end


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

! This file was ported from Lean 3 source module data.qpf.univariate.basic
! leanprover-community/mathlib commit 14b69e9f3c16630440a2cbd46f1ddad0d561dee7
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Pfunctor.Univariate.M

/-!

# Quotients of Polynomial Functors

We assume the following:

`P`   : a polynomial functor
`W`   : its W-type
`M`   : its M-type
`F`   : a functor

We define:

`q`   : `qpf` data, representing `F` as a quotient of `P`

The main goal is to construct:

`fix`   : the initial algebra with structure map `F fix → fix`.
`cofix` : the final coalgebra with structure map `cofix → F cofix`

We also show that the composition of qpfs is a qpf, and that the quotient of a qpf
is a qpf.

The present theory focuses on the univariate case for qpfs

## References

* [Jeremy Avigad, Mario M. Carneiro and Simon Hudon, *Data Types as Quotients of Polynomial Functors*][avigad-carneiro-hudon2019]

-/

universe u

/-- Quotients of polynomial functors.

Roughly speaking, saying that `F` is a quotient of a polynomial functor means that for each `α`,
elements of `F α` are represented by pairs `⟨a, f⟩`, where `a` is the shape of the object and
`f` indexes the relevant elements of `α`, in a suitably natural manner.
-/
class Qpf (F : Type u → Type u) [Functor F] where
  p : PFunctor.{u}
  abs : ∀ {α}, P.Obj α → F α
  repr : ∀ {α}, F α → P.Obj α
  abs_repr : ∀ {α} (x : F α), abs (repr x) = x
  abs_map : ∀ {α β} (f : α → β) (p : P.Obj α), abs (f <$> p) = f <$> abs p
#align qpf Qpf

namespace Qpf

variable {F : Type u → Type u} [Functor F] [q : Qpf F]

include q

open Functor (Liftp Liftr)

/-
Show that every qpf is a lawful functor.

Note: every functor has a field, `map_const`, and is_lawful_functor has the defining
characterization. We can only propagate the assumption.
-/
theorem id_map {α : Type _} (x : F α) : id <$> x = x :=
  by
  rw [← abs_repr x]
  cases' repr x with a f
  rw [← abs_map]
  rfl
#align qpf.id_map Qpf.id_map

theorem comp_map {α β γ : Type _} (f : α → β) (g : β → γ) (x : F α) :
    (g ∘ f) <$> x = g <$> f <$> x := by
  rw [← abs_repr x]
  cases' repr x with a f
  rw [← abs_map, ← abs_map, ← abs_map]
  rfl
#align qpf.comp_map Qpf.comp_map

theorem lawfulFunctor
    (h : ∀ α β : Type u, @Functor.mapConst F _ α _ = Functor.map ∘ Function.const β) :
    LawfulFunctor F :=
  { mapConst_eq := h
    id_map := @id_map F _ _
    comp_map := @comp_map F _ _ }
#align qpf.is_lawful_functor Qpf.lawfulFunctor

/-
Lifting predicates and relations
-/
section

open Functor

theorem liftp_iff {α : Type u} (p : α → Prop) (x : F α) :
    Liftp p x ↔ ∃ a f, x = abs ⟨a, f⟩ ∧ ∀ i, p (f i) :=
  by
  constructor
  · rintro ⟨y, hy⟩
    cases' h : repr y with a f
    use a, fun i => (f i).val
    constructor
    · rw [← hy, ← abs_repr y, h, ← abs_map]
      rfl
    intro i
    apply (f i).property
  rintro ⟨a, f, h₀, h₁⟩; dsimp at *
  use abs ⟨a, fun i => ⟨f i, h₁ i⟩⟩
  rw [← abs_map, h₀]; rfl
#align qpf.liftp_iff Qpf.liftp_iff

theorem liftp_iff' {α : Type u} (p : α → Prop) (x : F α) :
    Liftp p x ↔ ∃ u : q.p.Obj α, abs u = x ∧ ∀ i, p (u.snd i) :=
  by
  constructor
  · rintro ⟨y, hy⟩
    cases' h : repr y with a f
    use ⟨a, fun i => (f i).val⟩
    dsimp
    constructor
    · rw [← hy, ← abs_repr y, h, ← abs_map]
      rfl
    intro i
    apply (f i).property
  rintro ⟨⟨a, f⟩, h₀, h₁⟩; dsimp at *
  use abs ⟨a, fun i => ⟨f i, h₁ i⟩⟩
  rw [← abs_map, ← h₀]; rfl
#align qpf.liftp_iff' Qpf.liftp_iff'

theorem liftr_iff {α : Type u} (r : α → α → Prop) (x y : F α) :
    Liftr r x y ↔ ∃ a f₀ f₁, x = abs ⟨a, f₀⟩ ∧ y = abs ⟨a, f₁⟩ ∧ ∀ i, r (f₀ i) (f₁ i) :=
  by
  constructor
  · rintro ⟨u, xeq, yeq⟩
    cases' h : repr u with a f
    use a, fun i => (f i).val.fst, fun i => (f i).val.snd
    constructor
    · rw [← xeq, ← abs_repr u, h, ← abs_map]
      rfl
    constructor
    · rw [← yeq, ← abs_repr u, h, ← abs_map]
      rfl
    intro i
    exact (f i).property
  rintro ⟨a, f₀, f₁, xeq, yeq, h⟩
  use abs ⟨a, fun i => ⟨(f₀ i, f₁ i), h i⟩⟩
  dsimp; constructor
  · rw [xeq, ← abs_map]
    rfl
  rw [yeq, ← abs_map]; rfl
#align qpf.liftr_iff Qpf.liftr_iff

end

/-
Think of trees in the `W` type corresponding to `P` as representatives of elements of the
least fixed point of `F`, and assign a canonical representative to each equivalence class
of trees.
-/
/-- does recursion on `q.P.W` using `g : F α → α` rather than `g : P α → α` -/
def recF {α : Type _} (g : F α → α) : q.p.W → α
  | ⟨a, f⟩ => g (abs ⟨a, fun x => recF (f x)⟩)
#align qpf.recF Qpf.recF

theorem recF_eq {α : Type _} (g : F α → α) (x : q.p.W) : recF g x = g (abs (recF g <$> x.dest)) :=
  by cases x <;> rfl
#align qpf.recF_eq Qpf.recF_eq

theorem recF_eq' {α : Type _} (g : F α → α) (a : q.p.A) (f : q.p.B a → q.p.W) :
    recF g ⟨a, f⟩ = g (abs (recF g <$> ⟨a, f⟩)) :=
  rfl
#align qpf.recF_eq' Qpf.recF_eq'

/-- two trees are equivalent if their F-abstractions are -/
inductive Wequiv : q.p.W → q.p.W → Prop
  | ind (a : q.p.A) (f f' : q.p.B a → q.p.W) : (∀ x, Wequiv (f x) (f' x)) → Wequiv ⟨a, f⟩ ⟨a, f'⟩
  |
  abs (a : q.p.A) (f : q.p.B a → q.p.W) (a' : q.p.A) (f' : q.p.B a' → q.p.W) :
    abs ⟨a, f⟩ = abs ⟨a', f'⟩ → Wequiv ⟨a, f⟩ ⟨a', f'⟩
  | trans (u v w : q.p.W) : Wequiv u v → Wequiv v w → Wequiv u w
#align qpf.Wequiv Qpf.Wequiv

/-- recF is insensitive to the representation -/
theorem recF_eq_of_wequiv {α : Type u} (u : F α → α) (x y : q.p.W) :
    Wequiv x y → recF u x = recF u y := by
  cases' x with a f; cases' y with b g
  intro h; induction h
  case ind a f f' h ih => simp only [recF_eq', PFunctor.map_eq, Function.comp, ih]
  case abs a f a' f' h => simp only [recF_eq', abs_map, h]
  case trans x y z e₁ e₂ ih₁ ih₂ => exact Eq.trans ih₁ ih₂
#align qpf.recF_eq_of_Wequiv Qpf.recF_eq_of_wequiv

theorem Wequiv.abs' (x y : q.p.W) (h : abs x.dest = abs y.dest) : Wequiv x y :=
  by
  cases x
  cases y
  apply Wequiv.abs
  apply h
#align qpf.Wequiv.abs' Qpf.Wequiv.abs'

theorem Wequiv.refl (x : q.p.W) : Wequiv x x := by
  cases' x with a f <;> exact Wequiv.abs a f a f rfl
#align qpf.Wequiv.refl Qpf.Wequiv.refl

theorem Wequiv.symm (x y : q.p.W) : Wequiv x y → Wequiv y x :=
  by
  cases' x with a f; cases' y with b g
  intro h; induction h
  case ind a f f' h ih => exact Wequiv.ind _ _ _ ih
  case abs a f a' f' h => exact Wequiv.abs _ _ _ _ h.symm
  case trans x y z e₁ e₂ ih₁ ih₂ => exact Qpf.Wequiv.trans _ _ _ ih₂ ih₁
#align qpf.Wequiv.symm Qpf.Wequiv.symm

/-- maps every element of the W type to a canonical representative -/
def wrepr : q.p.W → q.p.W :=
  recF (PFunctor.W.mk ∘ repr)
#align qpf.Wrepr Qpf.wrepr

theorem wrepr_equiv (x : q.p.W) : Wequiv (wrepr x) x :=
  by
  induction' x with a f ih
  apply Wequiv.trans
  · change Wequiv (Wrepr ⟨a, f⟩) (PFunctor.W.mk (Wrepr <$> ⟨a, f⟩))
    apply Wequiv.abs'
    have : Wrepr ⟨a, f⟩ = PFunctor.W.mk (repr (abs (Wrepr <$> ⟨a, f⟩))) := rfl
    rw [this, PFunctor.W.dest_mk, abs_repr]
    rfl
  apply Wequiv.ind; exact ih
#align qpf.Wrepr_equiv Qpf.wrepr_equiv

/-- Define the fixed point as the quotient of trees under the equivalence relation `Wequiv`.
-/
def wSetoid : Setoid q.p.W :=
  ⟨Wequiv, @Wequiv.refl _ _ _, @Wequiv.symm _ _ _, @Wequiv.trans _ _ _⟩
#align qpf.W_setoid Qpf.wSetoid

attribute [local instance] W_setoid

/-- inductive type defined as initial algebra of a Quotient of Polynomial Functor -/
@[nolint has_nonempty_instance]
def Fix (F : Type u → Type u) [Functor F] [q : Qpf F] :=
  Quotient (wSetoid : Setoid q.p.W)
#align qpf.fix Qpf.Fix

/-- recursor of a type defined by a qpf -/
def Fix.rec {α : Type _} (g : F α → α) : Fix F → α :=
  Quot.lift (recF g) (recF_eq_of_wequiv g)
#align qpf.fix.rec Qpf.Fix.rec

/-- access the underlying W-type of a fixpoint data type -/
def fixToW : Fix F → q.p.W :=
  Quotient.lift wrepr (recF_eq_of_wequiv fun x => @PFunctor.W.mk q.p (repr x))
#align qpf.fix_to_W Qpf.fixToW

/-- constructor of a type defined by a qpf -/
def Fix.mk (x : F (Fix F)) : Fix F :=
  Quot.mk _ (PFunctor.W.mk (fixToW <$> repr x))
#align qpf.fix.mk Qpf.Fix.mk

/-- destructor of a type defined by a qpf -/
def Fix.dest : Fix F → F (Fix F) :=
  Fix.rec (Functor.map Fix.mk)
#align qpf.fix.dest Qpf.Fix.dest

theorem Fix.rec_eq {α : Type _} (g : F α → α) (x : F (Fix F)) :
    Fix.rec g (Fix.mk x) = g (Fix.rec g <$> x) :=
  by
  have : recF g ∘ fixToW = Fix.rec g := by
    apply funext
    apply Quotient.ind
    intro x
    apply recF_eq_of_Wequiv
    rw [fix_to_W]
    apply Wrepr_equiv
  conv =>
    lhs
    rw [fix.rec, fix.mk]
    dsimp
  cases' h : repr x with a f
  rw [PFunctor.map_eq, recF_eq, ← PFunctor.map_eq, PFunctor.W.dest_mk, ← PFunctor.comp_map, abs_map,
    ← h, abs_repr, this]
#align qpf.fix.rec_eq Qpf.Fix.rec_eq

theorem Fix.ind_aux (a : q.p.A) (f : q.p.B a → q.p.W) :
    Fix.mk (abs ⟨a, fun x => ⟦f x⟧⟩) = ⟦⟨a, f⟩⟧ :=
  by
  have : Fix.mk (abs ⟨a, fun x => ⟦f x⟧⟩) = ⟦wrepr ⟨a, f⟩⟧ :=
    by
    apply Quot.sound; apply Wequiv.abs'
    rw [PFunctor.W.dest_mk, abs_map, abs_repr, ← abs_map, PFunctor.map_eq]
    conv =>
      rhs
      simp only [Wrepr, recF_eq, PFunctor.W.dest_mk, abs_repr]
    rfl
  rw [this]
  apply Quot.sound
  apply Wrepr_equiv
#align qpf.fix.ind_aux Qpf.Fix.ind_aux

theorem Fix.ind_rec {α : Type u} (g₁ g₂ : Fix F → α)
    (h : ∀ x : F (Fix F), g₁ <$> x = g₂ <$> x → g₁ (Fix.mk x) = g₂ (Fix.mk x)) : ∀ x, g₁ x = g₂ x :=
  by
  apply Quot.ind
  intro x
  induction' x with a f ih
  change g₁ ⟦⟨a, f⟩⟧ = g₂ ⟦⟨a, f⟩⟧
  rw [← fix.ind_aux a f]; apply h
  rw [← abs_map, ← abs_map, PFunctor.map_eq, PFunctor.map_eq]
  dsimp [Function.comp]
  congr with x; apply ih
#align qpf.fix.ind_rec Qpf.Fix.ind_rec

theorem Fix.rec_unique {α : Type u} (g : F α → α) (h : Fix F → α)
    (hyp : ∀ x, h (Fix.mk x) = g (h <$> x)) : Fix.rec g = h :=
  by
  ext x
  apply fix.ind_rec
  intro x hyp'
  rw [hyp, ← hyp', fix.rec_eq]
#align qpf.fix.rec_unique Qpf.Fix.rec_unique

theorem Fix.mk_dest (x : Fix F) : Fix.mk (Fix.dest x) = x :=
  by
  change (fix.mk ∘ fix.dest) x = id x
  apply fix.ind_rec
  intro x; dsimp
  rw [fix.dest, fix.rec_eq, id_map, comp_map]
  intro h; rw [h]
#align qpf.fix.mk_dest Qpf.Fix.mk_dest

theorem Fix.dest_mk (x : F (Fix F)) : Fix.dest (Fix.mk x) = x :=
  by
  unfold fix.dest; rw [fix.rec_eq, ← fix.dest, ← comp_map]
  conv =>
    rhs
    rw [← id_map x]
  congr with x; apply fix.mk_dest
#align qpf.fix.dest_mk Qpf.Fix.dest_mk

theorem Fix.ind (p : Fix F → Prop) (h : ∀ x : F (Fix F), Liftp p x → p (Fix.mk x)) : ∀ x, p x :=
  by
  apply Quot.ind
  intro x
  induction' x with a f ih
  change p ⟦⟨a, f⟩⟧
  rw [← fix.ind_aux a f]
  apply h
  rw [liftp_iff]
  refine' ⟨_, _, rfl, _⟩
  apply ih
#align qpf.fix.ind Qpf.Fix.ind

end Qpf

/-
Construct the final coalgebra to a qpf.
-/
namespace Qpf

variable {F : Type u → Type u} [Functor F] [q : Qpf F]

include q

open Functor (Liftp Liftr)

/-- does recursion on `q.P.M` using `g : α → F α` rather than `g : α → P α` -/
def corecF {α : Type _} (g : α → F α) : α → q.p.M :=
  PFunctor.M.corec fun x => repr (g x)
#align qpf.corecF Qpf.corecF

theorem corecF_eq {α : Type _} (g : α → F α) (x : α) :
    PFunctor.M.dest (corecF g x) = corecF g <$> repr (g x) := by rw [corecF, PFunctor.M.dest_corec]
#align qpf.corecF_eq Qpf.corecF_eq

-- Equivalence
/-- A pre-congruence on q.P.M *viewed as an F-coalgebra*. Not necessarily symmetric. -/
def IsPrecongr (r : q.p.M → q.p.M → Prop) : Prop :=
  ∀ ⦃x y⦄, r x y → abs (Quot.mk r <$> PFunctor.M.dest x) = abs (Quot.mk r <$> PFunctor.M.dest y)
#align qpf.is_precongr Qpf.IsPrecongr

/-- The maximal congruence on q.P.M -/
def Mcongr : q.p.M → q.p.M → Prop := fun x y => ∃ r, IsPrecongr r ∧ r x y
#align qpf.Mcongr Qpf.Mcongr

/-- coinductive type defined as the final coalgebra of a qpf -/
def Cofix (F : Type u → Type u) [Functor F] [q : Qpf F] :=
  Quot (@Mcongr F _ q)
#align qpf.cofix Qpf.Cofix

instance [Inhabited q.p.A] : Inhabited (Cofix F) :=
  ⟨Quot.mk _ default⟩

/-- corecursor for type defined by `cofix` -/
def Cofix.corec {α : Type _} (g : α → F α) (x : α) : Cofix F :=
  Quot.mk _ (corecF g x)
#align qpf.cofix.corec Qpf.Cofix.corec

/-- destructor for type defined by `cofix` -/
def Cofix.dest : Cofix F → F (Cofix F) :=
  Quot.lift (fun x => Quot.mk Mcongr <$> abs (PFunctor.M.dest x))
    (by
      rintro x y ⟨r, pr, rxy⟩
      dsimp
      have : ∀ x y, r x y → Mcongr x y := by
        intro x y h
        exact ⟨r, pr, h⟩
      rw [← Quot.factor_mk_eq _ _ this]
      dsimp
      conv =>
        lhs
        rw [comp_map, ← abs_map, pr rxy, abs_map, ← comp_map])
#align qpf.cofix.dest Qpf.Cofix.dest

theorem Cofix.dest_corec {α : Type u} (g : α → F α) (x : α) :
    Cofix.dest (Cofix.corec g x) = Cofix.corec g <$> g x :=
  by
  conv =>
    lhs
    rw [cofix.dest, cofix.corec];
  dsimp
  rw [corecF_eq, abs_map, abs_repr, ← comp_map]; rfl
#align qpf.cofix.dest_corec Qpf.Cofix.dest_corec

private theorem cofix.bisim_aux (r : Cofix F → Cofix F → Prop) (h' : ∀ x, r x x)
    (h : ∀ x y, r x y → Quot.mk r <$> Cofix.dest x = Quot.mk r <$> Cofix.dest y) :
    ∀ x y, r x y → x = y := by
  intro x
  apply Quot.inductionOn x
  clear x
  intro x y
  apply Quot.inductionOn y
  clear y
  intro y rxy
  apply Quot.sound
  let r' x y := r (Quot.mk _ x) (Quot.mk _ y)
  have : is_precongr r' := by
    intro a b r'ab
    have h₀ :
      Quot.mk r <$> Quot.mk Mcongr <$> abs (PFunctor.M.dest a) =
        Quot.mk r <$> Quot.mk Mcongr <$> abs (PFunctor.M.dest b) :=
      h _ _ r'ab
    have h₁ : ∀ u v : q.P.M, Mcongr u v → Quot.mk r' u = Quot.mk r' v :=
      by
      intro u v cuv
      apply Quot.sound
      dsimp [r']
      rw [Quot.sound cuv]
      apply h'
    let f : Quot r → Quot r' :=
      Quot.lift (Quot.lift (Quot.mk r') h₁)
        (by
          intro c; apply Quot.inductionOn c; clear c
          intro c d; apply Quot.inductionOn d; clear d
          intro d rcd; apply Quot.sound; apply rcd)
    have : f ∘ Quot.mk r ∘ Quot.mk Mcongr = Quot.mk r' := rfl
    rw [← this, PFunctor.comp_map _ _ f, PFunctor.comp_map _ _ (Quot.mk r), abs_map, abs_map,
      abs_map, h₀]
    rw [PFunctor.comp_map _ _ f, PFunctor.comp_map _ _ (Quot.mk r), abs_map, abs_map, abs_map]
  refine' ⟨r', this, rxy⟩
#align qpf.cofix.bisim_aux qpf.cofix.bisim_aux

theorem Cofix.bisim_rel (r : Cofix F → Cofix F → Prop)
    (h : ∀ x y, r x y → Quot.mk r <$> Cofix.dest x = Quot.mk r <$> Cofix.dest y) :
    ∀ x y, r x y → x = y := by
  let r' (x y) := x = y ∨ r x y
  intro x y rxy
  apply cofix.bisim_aux r'
  · intro x
    left
    rfl
  · intro x y r'xy
    cases r'xy
    · rw [r'xy]
    have : ∀ x y, r x y → r' x y := fun x y h => Or.inr h
    rw [← Quot.factor_mk_eq _ _ this]
    dsimp
    rw [@comp_map _ _ q _ _ _ (Quot.mk r), @comp_map _ _ q _ _ _ (Quot.mk r)]
    rw [h _ _ r'xy]
  right; exact rxy
#align qpf.cofix.bisim_rel Qpf.Cofix.bisim_rel

theorem Cofix.bisim (r : Cofix F → Cofix F → Prop)
    (h : ∀ x y, r x y → Liftr r (Cofix.dest x) (Cofix.dest y)) : ∀ x y, r x y → x = y :=
  by
  apply cofix.bisim_rel
  intro x y rxy
  rcases(liftr_iff r _ _).mp (h x y rxy) with ⟨a, f₀, f₁, dxeq, dyeq, h'⟩
  rw [dxeq, dyeq, ← abs_map, ← abs_map, PFunctor.map_eq, PFunctor.map_eq]
  congr 2 with i
  apply Quot.sound
  apply h'
#align qpf.cofix.bisim Qpf.Cofix.bisim

theorem Cofix.bisim' {α : Type _} (Q : α → Prop) (u v : α → Cofix F)
    (h :
      ∀ x,
        Q x →
          ∃ a f f',
            Cofix.dest (u x) = abs ⟨a, f⟩ ∧
              Cofix.dest (v x) = abs ⟨a, f'⟩ ∧ ∀ i, ∃ x', Q x' ∧ f i = u x' ∧ f' i = v x') :
    ∀ x, Q x → u x = v x := fun x Qx =>
  let R := fun w z : Cofix F => ∃ x', Q x' ∧ w = u x' ∧ z = v x'
  Cofix.bisim R
    (fun x y ⟨x', Qx', xeq, yeq⟩ =>
      by
      rcases h x' Qx' with ⟨a, f, f', ux'eq, vx'eq, h'⟩
      rw [liftr_iff]
      refine' ⟨a, f, f', xeq.symm ▸ ux'eq, yeq.symm ▸ vx'eq, h'⟩)
    _ _ ⟨x, Qx, rfl, rfl⟩
#align qpf.cofix.bisim' Qpf.Cofix.bisim'

end Qpf

/-
Composition of qpfs.
-/
namespace Qpf

variable {F₂ : Type u → Type u} [Functor F₂] [q₂ : Qpf F₂]

variable {F₁ : Type u → Type u} [Functor F₁] [q₁ : Qpf F₁]

include q₂ q₁

/-- composition of qpfs gives another qpf  -/
def comp : Qpf (Functor.Comp F₂ F₁)
    where
  p := PFunctor.comp q₂.p q₁.p
  abs α := by
    dsimp [Functor.Comp]
    intro p
    exact abs ⟨p.1.1, fun x => abs ⟨p.1.2 x, fun y => p.2 ⟨x, y⟩⟩⟩
  repr α := by
    dsimp [Functor.Comp]
    intro y
    refine' ⟨⟨(repr y).1, fun u => (repr ((repr y).2 u)).1⟩, _⟩
    dsimp [PFunctor.comp]
    intro x
    exact (repr ((repr y).2 x.1)).snd x.2
  abs_repr α := by
    abstract
      dsimp [Functor.Comp]
      intro x
      conv =>
        rhs
        rw [← abs_repr x]
      cases' h : repr x with a f
      dsimp
      congr with x
      cases' h' : repr (f x) with b g
      dsimp; rw [← h', abs_repr]
  abs_map α β f := by
    abstract
      dsimp [Functor.Comp, PFunctor.comp]
      intro p
      cases' p with a g; dsimp
      cases' a with b h; dsimp
      symm
      trans
      symm
      apply abs_map
      congr
      rw [PFunctor.map_eq]
      dsimp [Function.comp]
      simp [abs_map]
      constructor
      rfl
      ext x
      rw [← abs_map]
      rfl
#align qpf.comp Qpf.comp

end Qpf

/-
Quotients.

We show that if `F` is a qpf and `G` is a suitable quotient of `F`, then `G` is a qpf.
-/
namespace Qpf

variable {F : Type u → Type u} [Functor F] [q : Qpf F]

variable {G : Type u → Type u} [Functor G]

variable {FG_abs : ∀ {α}, F α → G α}

variable {FG_repr : ∀ {α}, G α → F α}

/-- Given a qpf `F` and a well-behaved surjection `FG_abs` from F α to
functor G α, `G` is a qpf. We can consider `G` a quotient on `F` where
elements `x y : F α` are in the same equivalence class if
`FG_abs x = FG_abs y`  -/
def quotientQpf (FG_abs_repr : ∀ {α} (x : G α), FG_abs (FG_repr x) = x)
    (FG_abs_map : ∀ {α β} (f : α → β) (x : F α), FG_abs (f <$> x) = f <$> FG_abs x) : Qpf G
    where
  p := q.p
  abs {α} p := FG_abs (abs p)
  repr {α} x := repr (FG_repr x)
  abs_repr {α} x := by rw [abs_repr, FG_abs_repr]
  abs_map {α β} f x := by rw [abs_map, FG_abs_map]
#align qpf.quotient_qpf Qpf.quotientQpf

end Qpf

/-
Support.
-/
namespace Qpf

variable {F : Type u → Type u} [Functor F] [q : Qpf F]

include q

open Functor (Liftp Liftr supp)

open Set

theorem mem_supp {α : Type u} (x : F α) (u : α) :
    u ∈ supp x ↔ ∀ a f, abs ⟨a, f⟩ = x → u ∈ f '' univ :=
  by
  rw [supp]; dsimp; constructor
  · intro h a f haf
    have : liftp (fun u => u ∈ f '' univ) x :=
      by
      rw [liftp_iff]
      refine' ⟨a, f, haf.symm, fun i => mem_image_of_mem _ (mem_univ _)⟩
    exact h this
  intro h p; rw [liftp_iff]
  rintro ⟨a, f, xeq, h'⟩
  rcases h a f xeq.symm with ⟨i, _, hi⟩
  rw [← hi]; apply h'
#align qpf.mem_supp Qpf.mem_supp

theorem supp_eq {α : Type u} (x : F α) : supp x = { u | ∀ a f, abs ⟨a, f⟩ = x → u ∈ f '' univ } :=
  by ext <;> apply mem_supp
#align qpf.supp_eq Qpf.supp_eq

theorem has_good_supp_iff {α : Type u} (x : F α) :
    (∀ p, Liftp p x ↔ ∀ u ∈ supp x, p u) ↔
      ∃ a f, abs ⟨a, f⟩ = x ∧ ∀ a' f', abs ⟨a', f'⟩ = x → f '' univ ⊆ f' '' univ :=
  by
  constructor
  · intro h
    have : liftp (supp x) x := by rw [h] <;> intro u <;> exact id
    rw [liftp_iff] at this
    rcases this with ⟨a, f, xeq, h'⟩
    refine' ⟨a, f, xeq.symm, _⟩
    intro a' f' h''
    rintro u ⟨i, _, hfi⟩
    have : u ∈ supp x := by rw [← hfi] <;> apply h'
    exact (mem_supp x u).mp this _ _ h''
  rintro ⟨a, f, xeq, h⟩ p; rw [liftp_iff]; constructor
  · rintro ⟨a', f', xeq', h'⟩ u usuppx
    rcases(mem_supp x u).mp usuppx a' f' xeq'.symm with ⟨i, _, f'ieq⟩
    rw [← f'ieq]
    apply h'
  intro h'
  refine' ⟨a, f, xeq.symm, _⟩; intro i
  apply h'; rw [mem_supp]
  intro a' f' xeq'
  apply h a' f' xeq'
  apply mem_image_of_mem _ (mem_univ _)
#align qpf.has_good_supp_iff Qpf.has_good_supp_iff

variable (q)

/-- A qpf is said to be uniform if every polynomial functor
representing a single value all have the same range. -/
def IsUniform : Prop :=
  ∀ ⦃α : Type u⦄ (a a' : q.p.A) (f : q.p.B a → α) (f' : q.p.B a' → α),
    abs ⟨a, f⟩ = abs ⟨a', f'⟩ → f '' univ = f' '' univ
#align qpf.is_uniform Qpf.IsUniform

/-- does `abs` preserve `liftp`? -/
def LiftpPreservation : Prop :=
  ∀ ⦃α⦄ (p : α → Prop) (x : q.p.Obj α), Liftp p (abs x) ↔ Liftp p x
#align qpf.liftp_preservation Qpf.LiftpPreservation

/-- does `abs` preserve `supp`? -/
def SuppPreservation : Prop :=
  ∀ ⦃α⦄ (x : q.p.Obj α), supp (abs x) = supp x
#align qpf.supp_preservation Qpf.SuppPreservation

variable (q)

theorem supp_eq_of_isUniform (h : q.IsUniform) {α : Type u} (a : q.p.A) (f : q.p.B a → α) :
    supp (abs ⟨a, f⟩) = f '' univ := by
  ext u; rw [mem_supp]; constructor
  · intro h'
    apply h' _ _ rfl
  intro h' a' f' e
  rw [← h _ _ _ _ e.symm]; apply h'
#align qpf.supp_eq_of_is_uniform Qpf.supp_eq_of_isUniform

theorem liftp_iff_of_isUniform (h : q.IsUniform) {α : Type u} (x : F α) (p : α → Prop) :
    Liftp p x ↔ ∀ u ∈ supp x, p u :=
  by
  rw [liftp_iff, ← abs_repr x]
  cases' repr x with a f; constructor
  · rintro ⟨a', f', abseq, hf⟩ u
    rw [supp_eq_of_is_uniform h, h _ _ _ _ abseq]
    rintro ⟨i, _, hi⟩
    rw [← hi]
    apply hf
  intro h'
  refine' ⟨a, f, rfl, fun i => h' _ _⟩
  rw [supp_eq_of_is_uniform h]
  exact ⟨i, mem_univ i, rfl⟩
#align qpf.liftp_iff_of_is_uniform Qpf.liftp_iff_of_isUniform

theorem supp_map (h : q.IsUniform) {α β : Type u} (g : α → β) (x : F α) :
    supp (g <$> x) = g '' supp x := by
  rw [← abs_repr x]; cases' repr x with a f; rw [← abs_map, PFunctor.map_eq]
  rw [supp_eq_of_is_uniform h, supp_eq_of_is_uniform h, image_comp]
#align qpf.supp_map Qpf.supp_map

theorem suppPreservation_iff_uniform : q.SuppPreservation ↔ q.IsUniform :=
  by
  constructor
  · intro h α a a' f f' h'
    rw [← PFunctor.supp_eq, ← PFunctor.supp_eq, ← h, h', h]
  · rintro h α ⟨a, f⟩
    rwa [supp_eq_of_is_uniform, PFunctor.supp_eq]
#align qpf.supp_preservation_iff_uniform Qpf.suppPreservation_iff_uniform

theorem suppPreservation_iff_liftpPreservation : q.SuppPreservation ↔ q.LiftpPreservation :=
  by
  constructor <;> intro h
  · rintro α p ⟨a, f⟩
    have h' := h
    rw [supp_preservation_iff_uniform] at h'
    dsimp only [supp_preservation, supp] at h
    rwa [liftp_iff_of_is_uniform, supp_eq_of_is_uniform, PFunctor.liftp_iff'] <;> try assumption
    · simp only [image_univ, mem_range, exists_imp]
      constructor <;> intros <;> subst_vars <;> solve_by_elim
  · rintro α ⟨a, f⟩
    simp only [liftp_preservation] at h
    simp only [supp, h]
#align qpf.supp_preservation_iff_liftp_preservation Qpf.suppPreservation_iff_liftpPreservation

theorem liftpPreservation_iff_uniform : q.LiftpPreservation ↔ q.IsUniform := by
  rw [← supp_preservation_iff_liftp_preservation, supp_preservation_iff_uniform]
#align qpf.liftp_preservation_iff_uniform Qpf.liftpPreservation_iff_uniform

end Qpf


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

! This file was ported from Lean 3 source module category_theory.limits.constructions.filtered
! leanprover-community/mathlib commit e4ee4e30418efcb8cf304ba76ad653aeec04ba6e
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.CategoryTheory.Limits.Constructions.LimitsOfProductsAndEqualizers
import Mathlib.CategoryTheory.Limits.Opposites

/-!
# Constructing colimits from finite colimits and filtered colimits

We construct colimits of size `w` from finite colimits and filtered colimits of size `w`. Since
`w`-sized colimits are constructured from coequalizers and `w`-sized coproducts, it suffices to
construct `w`-sized coproducts from finite coproducts and `w`-sized filtered colimits.

The idea is simple: to construct coproducts of shape `α`, we take the colimit of the filtered
diagram of all coproducts of finite subsets of `α`.

We also deduce the dual statement by invoking the original statement in `Cᵒᵖ`.
-/

universe w v u

noncomputable section

open CategoryTheory

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

namespace CategoryTheory.Limits

namespace CoproductsFromFiniteFiltered

/-- If `C` has finite coproducts, a functor `Discrete α ⥤ C` lifts to a functor
    `Finset (Discrete α) ⥤ C` by taking coproducts. -/
@[simps!]
def liftToFinset [HasFiniteCoproducts C] (F : Discrete α ⥤ C) : Finset (Discrete α) ⥤ C where
  obj s := ∐ fun x : s => F.obj x
  map {_ Y} h := Sigma.desc fun y =>
    Sigma.ι (fun (x : { x // x ∈ Y }) => F.obj x) ⟨y, h.down.down y.2⟩
#align category_theory.limits.coproducts_from_finite_filtered.lift_to_finset CategoryTheory.Limits.CoproductsFromFiniteFiltered.liftToFinset

/-- If `C` has finite coproducts and filtered colimits, we can construct arbitrary coproducts by
    taking the colimit of the diagram formed by the coproducts of finite sets over the indexing
    type. -/
@[simps!]
def liftToFinsetColimitCocone [HasFiniteCoproducts C] [HasFilteredColimitsOfSize.{w, w} C]
    [DecidableEq α] (F : Discrete α ⥤ C) : ColimitCocone F where
  cocone :=
    { pt := colimit (liftToFinset F)
      ι :=
        Discrete.natTrans fun j =>
          @Sigma.ι _ _ _ (fun x : ({j} : Finset (Discrete α)) => F.obj x) _ ⟨j, by simp⟩ ≫
            colimit.ι (liftToFinset F) {j} }
  isColimit :=
    { desc := fun s =>
        colimit.desc (liftToFinset F)
          { pt := s.pt
            ι := { app := fun t => Sigma.desc fun x => s.ι.app x } }
      uniq := fun s m h => by
        apply colimit.hom_ext
        rintro t
        dsimp [liftToFinset]
        apply colimit.hom_ext
        rintro ⟨⟨j, hj⟩⟩
        convert h j using 1
        . simp [← colimit.w (liftToFinset F) ⟨⟨Finset.singleton_subset_iff.2 hj⟩⟩]
          rfl
        . aesop_cat }
#align category_theory.limits.coproducts_from_finite_filtered.lift_to_finset_colimit_cocone CategoryTheory.Limits.CoproductsFromFiniteFiltered.liftToFinsetColimitCocone

end CoproductsFromFiniteFiltered

open CoproductsFromFiniteFiltered

theorem hasCoproducts_of_finite_and_filtered [HasFiniteCoproducts C]
    [HasFilteredColimitsOfSize.{w, w} C] : HasCoproducts.{w} C := fun α => by
  classical exact ⟨fun F => HasColimit.mk (liftToFinsetColimitCocone F)⟩
#align category_theory.limits.has_coproducts_of_finite_and_filtered CategoryTheory.Limits.hasCoproducts_of_finite_and_filtered

theorem has_colimits_of_finite_and_filtered [HasFiniteColimits C]
    [HasFilteredColimitsOfSize.{w, w} C] : HasColimitsOfSize.{w, w} C :=
  have : HasCoproducts.{w} C := hasCoproducts_of_finite_and_filtered
  has_colimits_of_hasCoequalizers_and_coproducts
#align category_theory.limits.has_colimits_of_finite_and_filtered CategoryTheory.Limits.has_colimits_of_finite_and_filtered

theorem hasProducts_of_finite_and_cofiltered [HasFiniteProducts C]
    [HasCofilteredLimitsOfSize.{w, w} C] : HasProducts.{w} C :=
  have : HasCoproducts.{w} Cᵒᵖ := hasCoproducts_of_finite_and_filtered
  hasProducts_of_opposite
#align category_theory.limits.has_products_of_finite_and_cofiltered CategoryTheory.Limits.hasProducts_of_finite_and_cofiltered

theorem has_limits_of_finite_and_cofiltered [HasFiniteLimits C]
    [HasCofilteredLimitsOfSize.{w, w} C] : HasLimitsOfSize.{w, w} C :=
  have : HasProducts.{w} C := hasProducts_of_finite_and_cofiltered
  has_limits_of_hasEqualizers_and_products
#align category_theory.limits.has_limits_of_finite_and_cofiltered CategoryTheory.Limits.has_limits_of_finite_and_cofiltered

end CategoryTheory.Limits


example (p q r : Prop) (hp : p) :
    (p ∨ q ∨ r) ∧ (q ∨ p ∨ r) ∧ (q ∨ r ∨ p) :=
begin
  split,
    left,
    assumption,
  split,
    right,
    left,
    assumption,
  right,
  right,
  assumption
end

example (p q r : Prop) (hp : p) :
  (p ∨ q ∨ r) ∧ (q ∨ p ∨ r) ∧ (q ∨ r ∨ p) :=
by repeat { split <|> { try {left}, assumption } <|> right }


import game.limits.bounded_if_convergent -- hide
import game.limits.Lemmas -- hide
import game.limits.Blockus_time -- hide
import game.sets.L01defs -- hide
import game.sup_inf.GLBprop_if_LUBprop -- hide
import data.real.basic -- hide
import tactic.linarith -- hide

namespace xena -- hide

/-
# Chapter 7 : Limits

## Level 6

In this proof you will be showing that if you have two real numbers a and b in which b is positive.
and multiply them together, the product will be ≤ e * b if a ≤ e. This is true regardless of
what is being added to a * b or e * b as long as it is consistent.
Just like the last proof this should be a pretty obvious fact but to Lean it isn't trivial.

You will also be given some lemmas that are trivial that will not need to be proved but
will be useful in proving lim_mul.

-/

/-
Lemma : mul_div_mul_self
{a b c : ℝ} (h1 : 0 < a) (h2 : 0 < c) :  (b * a) / (c * a) = b/ c
-/

/-
Lemma : so_obvious
{a b c d: ℝ} (hb : 0 < b) (hc : 0 < c): a * b + c * d < a * b + b + d * c + c
-/

lemma pos_mul_pos_add_pos_mul_pos_le2 {a b c d e: ℝ} (hb : 0 ≤ b)
  (hae: a ≤ e): a * b + c * d ≤ e * b + c * d :=
begin
have L1 : b ≤ b, linarith,
have L2 : a * b ≤ e * b,
exact mul_le_mul_right1 hb hae,
linarith,

end

end xena -- hide


/-
Copyright (c) 2020 Markus Himmel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Markus Himmel, Jakob von Raumer
-/
import algebra.big_operators.basic
import algebra.hom.group
import algebra.module.basic
import category_theory.endomorphism
import category_theory.limits.shapes.kernels

/-!
# Preadditive categories

A preadditive category is a category in which `X ⟶ Y` is an abelian group in such a way that
composition of morphisms is linear in both variables.

This file contains a definition of preadditive category that directly encodes the definition given
above. The definition could also be phrased as follows: A preadditive category is a category
enriched over the category of Abelian groups. Once the general framework to state this in Lean is
available, the contents of this file should become obsolete.

## Main results

* Definition of preadditive categories and basic properties
* In a preadditive category, `f : Q ⟶ R` is mono if and only if `g ≫ f = 0 → g = 0` for all
  composable `g`.
* A preadditive category with kernels has equalizers.

## Implementation notes

The simp normal form for negation and composition is to push negations as far as possible to
the outside. For example, `f ≫ (-g)` and `(-f) ≫ g` both become `-(f ≫ g)`, and `(-f) ≫ (-g)`
is simplified to `f ≫ g`.

## References

* [F. Borceux, *Handbook of Categorical Algebra 2*][borceux-vol2]

## Tags

additive, preadditive, Hom group, Ab-category, Ab-enriched
-/

universes v u

open category_theory.limits

open_locale big_operators

namespace category_theory

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

/-- A category is called preadditive if `P ⟶ Q` is an abelian group such that composition is
    linear in both variables. -/
class preadditive :=
(hom_group : Π P Q : C, add_comm_group (P ⟶ Q) . tactic.apply_instance)
(add_comp' : ∀ (P Q R : C) (f f' : P ⟶ Q) (g : Q ⟶ R),
  (f + f') ≫ g = f ≫ g + f' ≫ g . obviously)
(comp_add' : ∀ (P Q R : C) (f : P ⟶ Q) (g g' : Q ⟶ R),
  f ≫ (g + g') = f ≫ g + f ≫ g' . obviously)

attribute [instance] preadditive.hom_group
restate_axiom preadditive.add_comp'
restate_axiom preadditive.comp_add'
attribute [simp,reassoc] preadditive.add_comp
attribute [reassoc] preadditive.comp_add -- (the linter doesn't like `simp` on this lemma)
attribute [simp] preadditive.comp_add

end category_theory

open category_theory

namespace category_theory
namespace preadditive

section preadditive
open add_monoid_hom
variables {C : Type u} [category.{v} C] [preadditive C]

section induced_category
universes u'
variables {C} {D : Type u'} (F : D → C)

instance induced_category.category : preadditive.{v} (induced_category C F) :=
{ hom_group := λ P Q, @preadditive.hom_group C _ _ (F P) (F Q),
  add_comp' := λ P Q R f f' g, add_comp' _ _ _ _ _ _,
  comp_add' := λ P Q R f g g', comp_add' _ _ _ _ _ _, }

end induced_category

instance (X : C) : add_comm_group (End X) := by { dsimp [End], apply_instance, }

instance (X : C) : ring (End X) :=
{ left_distrib := λ f g h, preadditive.add_comp X X X g h f,
  right_distrib := λ f g h, preadditive.comp_add X X X h f g,
  ..(infer_instance : add_comm_group (End X)),
  ..(infer_instance : monoid (End X)) }

/-- Composition by a fixed left argument as a group homomorphism -/
def left_comp {P Q : C} (R : C) (f : P ⟶ Q) : (Q ⟶ R) →+ (P ⟶ R) :=
mk' (λ g, f ≫ g) $ λ g g', by simp

/-- Composition by a fixed right argument as a group homomorphism -/
def right_comp (P : C) {Q R : C} (g : Q ⟶ R) : (P ⟶ Q) →+ (P ⟶ R) :=
mk' (λ f, f ≫ g) $ λ f f', by simp

variables {P Q R : C} (f f' : P ⟶ Q) (g g' : Q ⟶ R)

/-- Composition as a bilinear group homomorphism -/
def comp_hom : (P ⟶ Q) →+ (Q ⟶ R) →+ (P ⟶ R) :=
add_monoid_hom.mk' (λ f, left_comp _ f) $
  λ f₁ f₂, add_monoid_hom.ext $ λ g, (right_comp _ g).map_add f₁ f₂

@[simp, reassoc] lemma sub_comp :
  (f - f') ≫ g = f ≫ g - f' ≫ g :=
map_sub (right_comp P g) f f'

-- The redundant simp lemma linter says that simp can prove the reassoc version of this lemma.
@[reassoc, simp] lemma comp_sub :
  f ≫ (g - g') = f ≫ g - f ≫ g' :=
map_sub (left_comp R f) g g'

@[simp, reassoc] lemma neg_comp : (-f) ≫ g = -(f ≫ g) :=
map_neg (right_comp P g) f

/- The redundant simp lemma linter says that simp can prove the reassoc version of this lemma. -/
@[reassoc, simp] lemma comp_neg : f ≫ (-g) = -(f ≫ g) :=
map_neg (left_comp R f) g

@[reassoc] lemma neg_comp_neg : (-f) ≫ (-g) = f ≫ g :=
by simp

lemma nsmul_comp (n : ℕ) : (n • f) ≫ g = n • (f ≫ g) :=
map_nsmul (right_comp P g) n f

lemma comp_nsmul (n : ℕ) : f ≫ (n • g) = n • (f ≫ g) :=
map_nsmul (left_comp R f) n g

lemma zsmul_comp (n : ℤ) : (n • f) ≫ g = n • (f ≫ g) :=
map_zsmul (right_comp P g) n f

lemma comp_zsmul (n : ℤ) : f ≫ (n • g) = n • (f ≫ g) :=
map_zsmul (left_comp R f) n g

@[reassoc] lemma comp_sum {P Q R : C} {J : Type*} (s : finset J) (f : P ⟶ Q) (g : J → (Q ⟶ R)) :
  f ≫ ∑ j in s, g j = ∑ j in s, f ≫ g j :=
map_sum (left_comp R f) _ _

@[reassoc] lemma sum_comp {P Q R : C} {J : Type*} (s : finset J) (f : J → (P ⟶ Q)) (g : Q ⟶ R) :
  (∑ j in s, f j) ≫ g  = ∑ j in s, f j ≫ g :=
map_sum (right_comp P g) _ _

instance {P Q : C} {f : P ⟶ Q} [epi f] : epi (-f) :=
⟨λ R g g' H, by rwa [neg_comp, neg_comp, ←comp_neg, ←comp_neg, cancel_epi, neg_inj] at H⟩

instance {P Q : C} {f : P ⟶ Q} [mono f] : mono (-f) :=
⟨λ R g g' H, by rwa [comp_neg, comp_neg, ←neg_comp, ←neg_comp, cancel_mono, neg_inj] at H⟩

@[priority 100]
instance preadditive_has_zero_morphisms : has_zero_morphisms C :=
{ has_zero := infer_instance,
  comp_zero' := λ P Q f R, show left_comp R f 0 = 0, from map_zero _,
  zero_comp' := λ P Q R f, show right_comp P f 0 = 0, from map_zero _ }

instance module_End_right {X Y : C} : module (End Y) (X ⟶ Y) :=
{ smul_add := λ r f g, add_comp _ _ _ _ _ _,
  smul_zero := λ r, zero_comp,
  add_smul := λ r s f, comp_add _ _ _ _ _ _,
  zero_smul := λ r, comp_zero }

lemma mono_of_cancel_zero {Q R : C} (f : Q ⟶ R) (h : ∀ {P : C} (g : P ⟶ Q), g ≫ f = 0 → g = 0) :
  mono f :=
⟨λ P g g' hg, sub_eq_zero.1 $ h _ $ (map_sub (right_comp P f) g g').trans $ sub_eq_zero.2 hg⟩

lemma mono_iff_cancel_zero {Q R : C} (f : Q ⟶ R) :
  mono f ↔ ∀ (P : C) (g : P ⟶ Q), g ≫ f = 0 → g = 0 :=
⟨λ m P g, by exactI zero_of_comp_mono _, mono_of_cancel_zero f⟩

lemma mono_of_kernel_zero {X Y : C} {f : X ⟶ Y} [has_limit (parallel_pair f 0)]
  (w : kernel.ι f = 0) : mono f :=
mono_of_cancel_zero f (λ P g h, by rw [←kernel.lift_ι f g h, w, limits.comp_zero])

lemma epi_of_cancel_zero {P Q : C} (f : P ⟶ Q) (h : ∀ {R : C} (g : Q ⟶ R), f ≫ g = 0 → g = 0) :
  epi f :=
⟨λ R g g' hg, sub_eq_zero.1 $ h _ $ (map_sub (left_comp R f) g g').trans $ sub_eq_zero.2 hg⟩

lemma epi_iff_cancel_zero {P Q : C} (f : P ⟶ Q) :
  epi f ↔ ∀ (R : C) (g : Q ⟶ R), f ≫ g = 0 → g = 0 :=
⟨λ e R g, by exactI zero_of_epi_comp _, epi_of_cancel_zero f⟩

lemma epi_of_cokernel_zero {X Y : C} {f : X ⟶ Y} [has_colimit (parallel_pair f 0 )]
  (w : cokernel.π f = 0) : epi f :=
epi_of_cancel_zero f (λ P g h, by rw [←cokernel.π_desc f g h, w, limits.zero_comp])

namespace is_iso

@[simp] lemma comp_left_eq_zero [is_iso f] :
  f ≫ g = 0 ↔ g = 0 :=
by rw [← is_iso.eq_inv_comp, limits.comp_zero]

@[simp] lemma comp_right_eq_zero [is_iso g] :
  f ≫ g = 0 ↔ f = 0 :=
by rw [← is_iso.eq_comp_inv, limits.zero_comp]

end is_iso

open_locale zero_object
variables [has_zero_object C]

lemma mono_of_kernel_iso_zero {X Y : C} {f : X ⟶ Y} [has_limit (parallel_pair f 0)]
  (w : kernel f ≅ 0) : mono f :=
mono_of_kernel_zero (zero_of_source_iso_zero _ w)

lemma epi_of_cokernel_iso_zero {X Y : C} {f : X ⟶ Y} [has_colimit (parallel_pair f 0)]
  (w : cokernel f ≅ 0) : epi f :=
epi_of_cokernel_zero (zero_of_target_iso_zero _ w)

end preadditive

section equalizers
variables {C : Type u} [category.{v} C] [preadditive C]

section
variables {X Y : C} {f : X ⟶ Y} {g : X ⟶ Y}

/-- Map a kernel cone on the difference of two morphisms to the equalizer fork. -/
def fork_of_kernel_fork (c : kernel_fork (f - g)) : fork f g :=
fork.of_ι c.ι $ by rw [← sub_eq_zero, ← comp_sub, c.condition]

/-- Map any equalizer fork to a cone on the difference of the two morphisms. -/
def kernel_fork_of_fork (c : fork f g) : kernel_fork (f - g) :=
fork.of_ι c.ι $ by rw [comp_sub, comp_zero, sub_eq_zero, c.condition]

@[simp] lemma kernel_fork_of_fork_ι (c : fork f g) : (kernel_fork_of_fork c).ι = c.ι := rfl

@[simp] lemma kernel_fork_of_fork_of_ι {P : C} (ι : P ⟶ X) (w : ι ≫ f = ι ≫ g) :
  (kernel_fork_of_fork (fork.of_ι ι w)) = kernel_fork.of_ι ι (by simp [w]) := rfl

/-- A kernel of `f - g` is an equalizer of `f` and `g`. -/
def is_limit_fork_of_kernel_fork {c : kernel_fork (f - g)} (i : is_limit c) :
  is_limit (fork_of_kernel_fork c) :=
fork.is_limit.mk' _ $ λ s,
  ⟨i.lift (kernel_fork_of_fork s), i.fac _ _,
   λ m h, by apply fork.is_limit.hom_ext i; tidy⟩

@[simp]
lemma is_limit_fork_of_kernel_fork_lift {c : kernel_fork (f - g)} (i : is_limit c) (s : fork f g) :
  (is_limit_fork_of_kernel_fork i).lift s = i.lift (kernel_fork_of_fork s) := rfl

/-- An equalizer of `f` and `g` is a kernel of `f - g`. -/
def is_limit_kernel_fork_of_fork {c : fork f g} (i : is_limit c) :
  is_limit (kernel_fork_of_fork c) :=
fork.is_limit.mk' _ $ λ s,
  ⟨i.lift (fork_of_kernel_fork s), i.fac _ _,
    λ m h, by apply fork.is_limit.hom_ext i; tidy⟩

variables (f g)

/-- A preadditive category has an equalizer for `f` and `g` if it has a kernel for `f - g`. -/
lemma has_equalizer_of_has_kernel [has_kernel (f - g)] : has_equalizer f g :=
has_limit.mk { cone := fork_of_kernel_fork _,
  is_limit := is_limit_fork_of_kernel_fork (equalizer_is_equalizer (f - g) 0) }

/-- A preadditive category has a kernel for `f - g` if it has an equalizer for `f` and `g`. -/
lemma has_kernel_of_has_equalizer [has_equalizer f g] : has_kernel (f - g) :=
has_limit.mk { cone := kernel_fork_of_fork (equalizer.fork f g),
  is_limit := is_limit_kernel_fork_of_fork (limit.is_limit (parallel_pair f g)) }

variables {f g}

/-- Map a cokernel cocone on the difference of two morphisms to the coequalizer cofork. -/
def cofork_of_cokernel_cofork (c : cokernel_cofork (f - g)) : cofork f g :=
cofork.of_π c.π $ by rw [← sub_eq_zero, ← sub_comp, c.condition]

/-- Map any coequalizer cofork to a cocone on the difference of the two morphisms. -/
def cokernel_cofork_of_cofork (c : cofork f g) : cokernel_cofork (f - g) :=
cofork.of_π c.π $ by rw [sub_comp, zero_comp, sub_eq_zero, c.condition]

@[simp] lemma cokernel_cofork_of_cofork_π (c : cofork f g) :
  (cokernel_cofork_of_cofork c).π = c.π := rfl

@[simp] lemma cokernel_cofork_of_cofork_of_π {P : C} (π : Y ⟶ P) (w : f ≫ π = g ≫ π) :
  (cokernel_cofork_of_cofork (cofork.of_π π w)) = cokernel_cofork.of_π π (by simp [w]) := rfl

/-- A cokernel of `f - g` is a coequalizer of `f` and `g`. -/
def is_colimit_cofork_of_cokernel_cofork {c : cokernel_cofork (f - g)} (i : is_colimit c) :
  is_colimit (cofork_of_cokernel_cofork c) :=
cofork.is_colimit.mk' _ $ λ s,
  ⟨i.desc (cokernel_cofork_of_cofork s), i.fac _ _,
    λ m h, by apply cofork.is_colimit.hom_ext i; tidy⟩

@[simp]
lemma is_colimit_cofork_of_cokernel_cofork_desc {c : cokernel_cofork (f - g)}
  (i : is_colimit c) (s : cofork f g) :
  (is_colimit_cofork_of_cokernel_cofork i).desc s = i.desc (cokernel_cofork_of_cofork s) := rfl

/-- A coequalizer of `f` and `g` is a cokernel of `f - g`. -/
def is_colimit_cokernel_cofork_of_cofork {c : cofork f g} (i : is_colimit c) :
  is_colimit (cokernel_cofork_of_cofork c) :=
cofork.is_colimit.mk' _ $ λ s,
  ⟨i.desc (cofork_of_cokernel_cofork s), i.fac _ _,
    λ m h, by apply cofork.is_colimit.hom_ext i; tidy⟩

variables (f g)

/-- A preadditive category has a coequalizer for `f` and `g` if it has a cokernel for `f - g`. -/
lemma has_coequalizer_of_has_cokernel [has_cokernel (f - g)] : has_coequalizer f g :=
has_colimit.mk { cocone := cofork_of_cokernel_cofork _,
  is_colimit := is_colimit_cofork_of_cokernel_cofork (coequalizer_is_coequalizer (f - g) 0) }

/-- A preadditive category has a cokernel for `f - g` if it has a coequalizer for `f` and `g`. -/
lemma has_cokernel_of_has_coequalizer [has_coequalizer f g] : has_cokernel (f - g) :=
has_colimit.mk { cocone := cokernel_cofork_of_cofork (coequalizer.cofork f g),
  is_colimit := is_colimit_cokernel_cofork_of_cofork (colimit.is_colimit (parallel_pair f g)) }

end

/-- If a preadditive category has all kernels, then it also has all equalizers. -/
lemma has_equalizers_of_has_kernels [has_kernels C] : has_equalizers C :=
@has_equalizers_of_has_limit_parallel_pair _ _ (λ _ _ f g, has_equalizer_of_has_kernel f g)

/-- If a preadditive category has all cokernels, then it also has all coequalizers. -/
lemma has_coequalizers_of_has_cokernels [has_cokernels C] : has_coequalizers C :=
@has_coequalizers_of_has_colimit_parallel_pair _ _ (λ _ _ f g, has_coequalizer_of_has_cokernel f g)

end equalizers

end preadditive

end category_theory


/-
Copyright (c) 2019 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Mario Carneiro
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.equiv.encodable.basic
import Mathlib.algebra.euclidean_domain
import Mathlib.data.nat.gcd
import Mathlib.data.int.cast
import Mathlib.PostPort

universes l u

namespace Mathlib

/-!
# Basics for the Rational Numbers

## Summary

We define a rational number `q` as a structure `{ num, denom, pos, cop }`, where
- `num` is the numerator of `q`,
- `denom` is the denominator of `q`,
- `pos` is a proof that `denom > 0`, and
- `cop` is a proof `num` and `denom` are coprime.

We then define the expected (discrete) field structure on `ℚ` and prove basic lemmas about it.
Moreoever, we provide the expected casts from `ℕ` and `ℤ` into `ℚ`, i.e. `(↑n : ℚ) = n / 1`.

## Main Definitions

- `rat` is the structure encoding `ℚ`.
- `rat.mk n d` constructs a rational number `q = n / d` from `n d : ℤ`.

## Notations

- `/.` is infix notation for `rat.mk`.

## Tags

rat, rationals, field, ℚ, numerator, denominator, num, denom
-/

/-- `rat`, or `ℚ`, is the type of rational numbers. It is defined
  as the set of pairs ⟨n, d⟩ of integers such that `d` is positive and `n` and
  `d` are coprime. This representation is preferred to the quotient
  because without periodic reduction, the numerator and denominator can grow
  exponentially (for example, adding 1/2 to itself repeatedly). -/
structure rat where
  mk' :: (num : ℤ) (denom : ℕ) (pos : 0 < denom) (cop : nat.coprime (int.nat_abs num) denom)

notation:1024 "ℚ" => Mathlib.rat

namespace rat

protected def repr : ℚ → string := sorry

protected instance has_repr : has_repr ℚ := has_repr.mk rat.repr

protected instance has_to_string : has_to_string ℚ := has_to_string.mk rat.repr

protected instance encodable : encodable ℚ :=
  encodable.of_equiv
    (sigma fun (n : ℤ) => Subtype fun (d : ℕ) => 0 < d ∧ nat.coprime (int.nat_abs n) d)
    (equiv.mk (fun (_x : ℚ) => sorry)
      (fun
        (_x : sigma fun (n : ℤ) => Subtype fun (d : ℕ) => 0 < d ∧ nat.coprime (int.nat_abs n) d) =>
        sorry)
      sorry sorry)

/-- Embed an integer as a rational number -/
def of_int (n : ℤ) : ℚ := mk' n 1 nat.one_pos sorry

protected instance has_zero : HasZero ℚ := { zero := of_int 0 }

protected instance has_one : HasOne ℚ := { one := of_int 1 }

protected instance inhabited : Inhabited ℚ := { default := 0 }

/-- Form the quotient `n / d` where `n:ℤ` and `d:ℕ+` (not necessarily coprime) -/
def mk_pnat (n : ℤ) : ℕ+ → ℚ := sorry

/-- Form the quotient `n / d` where `n:ℤ` and `d:ℕ`. In the case `d = 0`, we
  define `n / 0 = 0` by convention. -/
def mk_nat (n : ℤ) (d : ℕ) : ℚ :=
  dite (d = 0) (fun (d0 : d = 0) => 0)
    fun (d0 : ¬d = 0) => mk_pnat n { val := d, property := nat.pos_of_ne_zero d0 }

/-- Form the quotient `n / d` where `n d : ℤ`. -/
def mk : ℤ → ℤ → ℚ := sorry

theorem mk_pnat_eq (n : ℤ) (d : ℕ) (h : 0 < d) : mk_pnat n { val := d, property := h } = mk n ↑d :=
  sorry

theorem mk_nat_eq (n : ℤ) (d : ℕ) : mk_nat n d = mk n ↑d := rfl

@[simp] theorem mk_zero (n : ℤ) : mk n 0 = 0 := rfl

@[simp] theorem zero_mk_pnat (n : ℕ+) : mk_pnat 0 n = 0 := sorry

@[simp] theorem zero_mk_nat (n : ℕ) : mk_nat 0 n = 0 := sorry

@[simp] theorem zero_mk (n : ℤ) : mk 0 n = 0 := sorry

@[simp] theorem mk_eq_zero {a : ℤ} {b : ℤ} (b0 : b ≠ 0) : mk a b = 0 ↔ a = 0 := sorry

theorem mk_eq {a : ℤ} {b : ℤ} {c : ℤ} {d : ℤ} (hb : b ≠ 0) (hd : d ≠ 0) :
    mk a b = mk c d ↔ a * d = c * b :=
  sorry

@[simp] theorem div_mk_div_cancel_left {a : ℤ} {b : ℤ} {c : ℤ} (c0 : c ≠ 0) :
    mk (a * c) (b * c) = mk a b :=
  sorry

@[simp] theorem num_denom {a : ℚ} : mk (num a) ↑(denom a) = a := sorry

theorem num_denom' {n : ℤ} {d : ℕ} {h : 0 < d} {c : nat.coprime (int.nat_abs n) d} :
    mk' n d h c = mk n ↑d :=
  Eq.symm num_denom

theorem of_int_eq_mk (z : ℤ) : of_int z = mk z 1 := num_denom'

def num_denom_cases_on {C : ℚ → Sort u} (a : ℚ)
    (H : (n : ℤ) → (d : ℕ) → 0 < d → nat.coprime (int.nat_abs n) d → C (mk n ↑d)) : C a :=
  sorry

def num_denom_cases_on' {C : ℚ → Sort u} (a : ℚ) (H : (n : ℤ) → (d : ℕ) → d ≠ 0 → C (mk n ↑d)) :
    C a :=
  num_denom_cases_on a
    fun (n : ℤ) (d : ℕ) (h : 0 < d) (c : nat.coprime (int.nat_abs n) d) => H n d sorry

theorem num_dvd (a : ℤ) {b : ℤ} (b0 : b ≠ 0) : num (mk a b) ∣ a := sorry

theorem denom_dvd (a : ℤ) (b : ℤ) : ↑(denom (mk a b)) ∣ b := sorry

protected def add : ℚ → ℚ → ℚ := sorry

protected instance has_add : Add ℚ := { add := rat.add }

theorem lift_binop_eq (f : ℚ → ℚ → ℚ) (f₁ : ℤ → ℤ → ℤ → ℤ → ℤ) (f₂ : ℤ → ℤ → ℤ → ℤ → ℤ)
    (fv :
      ∀ {n₁ : ℤ} {d₁ : ℕ} {h₁ : 0 < d₁} {c₁ : nat.coprime (int.nat_abs n₁) d₁} {n₂ : ℤ} {d₂ : ℕ}
        {h₂ : 0 < d₂} {c₂ : nat.coprime (int.nat_abs n₂) d₂},
        f (mk' n₁ d₁ h₁ c₁) (mk' n₂ d₂ h₂ c₂) = mk (f₁ n₁ (↑d₁) n₂ ↑d₂) (f₂ n₁ (↑d₁) n₂ ↑d₂))
    (f0 : ∀ {n₁ d₁ n₂ d₂ : ℤ}, d₁ ≠ 0 → d₂ ≠ 0 → f₂ n₁ d₁ n₂ d₂ ≠ 0) (a : ℤ) (b : ℤ) (c : ℤ) (d : ℤ)
    (b0 : b ≠ 0) (d0 : d ≠ 0)
    (H :
      ∀ {n₁ d₁ n₂ d₂ : ℤ},
        a * d₁ = n₁ * b →
          c * d₂ = n₂ * d → f₁ n₁ d₁ n₂ d₂ * f₂ a b c d = f₁ a b c d * f₂ n₁ d₁ n₂ d₂) :
    f (mk a b) (mk c d) = mk (f₁ a b c d) (f₂ a b c d) :=
  sorry

@[simp] theorem add_def {a : ℤ} {b : ℤ} {c : ℤ} {d : ℤ} (b0 : b ≠ 0) (d0 : d ≠ 0) :
    mk a b + mk c d = mk (a * d + c * b) (b * d) :=
  sorry

protected def neg : ℚ → ℚ := sorry

protected instance has_neg : Neg ℚ := { neg := rat.neg }

@[simp] theorem neg_def {a : ℤ} {b : ℤ} : -mk a b = mk (-a) b := sorry

protected def mul : ℚ → ℚ → ℚ := sorry

protected instance has_mul : Mul ℚ := { mul := rat.mul }

@[simp] theorem mul_def {a : ℤ} {b : ℤ} {c : ℤ} {d : ℤ} (b0 : b ≠ 0) (d0 : d ≠ 0) :
    mk a b * mk c d = mk (a * c) (b * d) :=
  sorry

protected def inv : ℚ → ℚ := sorry

protected instance has_inv : has_inv ℚ := has_inv.mk rat.inv

@[simp] theorem inv_def {a : ℤ} {b : ℤ} : mk a b⁻¹ = mk b a := sorry

protected theorem add_zero (a : ℚ) : a + 0 = a := sorry

protected theorem zero_add (a : ℚ) : 0 + a = a := sorry

protected theorem add_comm (a : ℚ) (b : ℚ) : a + b = b + a := sorry

protected theorem add_assoc (a : ℚ) (b : ℚ) (c : ℚ) : a + b + c = a + (b + c) := sorry

protected theorem add_left_neg (a : ℚ) : -a + a = 0 := sorry

protected theorem mul_one (a : ℚ) : a * 1 = a := sorry

protected theorem one_mul (a : ℚ) : 1 * a = a := sorry

protected theorem mul_comm (a : ℚ) (b : ℚ) : a * b = b * a := sorry

protected theorem mul_assoc (a : ℚ) (b : ℚ) (c : ℚ) : a * b * c = a * (b * c) := sorry

protected theorem add_mul (a : ℚ) (b : ℚ) (c : ℚ) : (a + b) * c = a * c + b * c := sorry

protected theorem mul_add (a : ℚ) (b : ℚ) (c : ℚ) : a * (b + c) = a * b + a * c := sorry

protected theorem zero_ne_one : 0 ≠ 1 :=
  mt (fun (h : 0 = mk 1 1) => iff.mp (mk_eq_zero one_ne_zero) (Eq.symm h)) one_ne_zero

protected theorem mul_inv_cancel (a : ℚ) : a ≠ 0 → a * (a⁻¹) = 1 := sorry

protected theorem inv_mul_cancel (a : ℚ) (h : a ≠ 0) : a⁻¹ * a = 1 :=
  Eq.trans (rat.mul_comm (a⁻¹) a) (rat.mul_inv_cancel a h)

protected instance decidable_eq : DecidableEq ℚ :=
  id
    fun (_v : ℚ) =>
      cases_on _v
        fun (num : ℤ) (denom : ℕ) (pos : 0 < denom) (cop : nat.coprime (int.nat_abs num) denom)
          (w : ℚ) =>
          cases_on w
            fun (w_num : ℤ) (w_denom : ℕ) (w_pos : 0 < w_denom)
              (w_cop : nat.coprime (int.nat_abs w_num) w_denom) =>
              decidable.by_cases
                (fun (ᾰ : num = w_num) =>
                  Eq._oldrec
                    (fun (w_cop : nat.coprime (int.nat_abs num) w_denom) =>
                      decidable.by_cases
                        (fun (ᾰ : denom = w_denom) =>
                          Eq._oldrec
                            (fun (w_pos : 0 < denom)
                              (w_cop : nat.coprime (int.nat_abs num) denom) => is_true sorry)
                            ᾰ w_pos w_cop)
                        fun (ᾰ : ¬denom = w_denom) => isFalse sorry)
                    ᾰ w_cop)
                fun (ᾰ : ¬num = w_num) => isFalse sorry

protected instance field : field ℚ :=
  field.mk rat.add rat.add_assoc 0 rat.zero_add rat.add_zero rat.neg
    (comm_ring.sub._default rat.add rat.add_assoc 0 rat.zero_add rat.add_zero rat.neg)
    rat.add_left_neg rat.add_comm rat.mul rat.mul_assoc 1 rat.one_mul rat.mul_one rat.mul_add
    rat.add_mul rat.mul_comm rat.inv sorry rat.mul_inv_cancel sorry

/- Extra instances to short-circuit type class resolution -/

protected instance division_ring : division_ring ℚ := field.to_division_ring

-- TODO(Mario): this instance slows down data.real.basic

protected instance integral_domain : integral_domain ℚ := field.to_integral_domain

--instance : domain ℚ           := by apply_instance

protected instance nontrivial : nontrivial ℚ := euclidean_domain.to_nontrivial ℚ

--instance : ring ℚ             := by apply_instance

protected instance comm_ring : comm_ring ℚ := euclidean_domain.to_comm_ring ℚ

protected instance comm_semiring : comm_semiring ℚ := comm_ring.to_comm_semiring

protected instance semiring : semiring ℚ := ring.to_semiring

protected instance add_comm_group : add_comm_group ℚ := ring.to_add_comm_group ℚ

protected instance add_group : add_group ℚ := add_comm_group.to_add_group ℚ

protected instance add_comm_monoid : add_comm_monoid ℚ := add_comm_group.to_add_comm_monoid ℚ

protected instance add_monoid : add_monoid ℚ := sub_neg_monoid.to_add_monoid ℚ

protected instance add_left_cancel_semigroup : add_left_cancel_semigroup ℚ :=
  add_left_cancel_monoid.to_add_left_cancel_semigroup ℚ

protected instance add_right_cancel_semigroup : add_right_cancel_semigroup ℚ :=
  add_right_cancel_monoid.to_add_right_cancel_semigroup ℚ

protected instance add_comm_semigroup : add_comm_semigroup ℚ :=
  add_comm_monoid.to_add_comm_semigroup ℚ

protected instance add_semigroup : add_semigroup ℚ := add_monoid.to_add_semigroup ℚ

protected instance comm_monoid : comm_monoid ℚ := comm_semiring.to_comm_monoid ℚ

protected instance monoid : monoid ℚ := ring.to_monoid ℚ

protected instance comm_semigroup : comm_semigroup ℚ := comm_ring.to_comm_semigroup ℚ

protected instance semigroup : semigroup ℚ := monoid.to_semigroup ℚ

theorem sub_def {a : ℤ} {b : ℤ} {c : ℤ} {d : ℤ} (b0 : b ≠ 0) (d0 : d ≠ 0) :
    mk a b - mk c d = mk (a * d - c * b) (b * d) :=
  sorry

@[simp] theorem denom_neg_eq_denom (q : ℚ) : denom (-q) = denom q :=
  cases_on q
    fun (q_num : ℤ) (q_denom : ℕ) (q_pos : 0 < q_denom)
      (q_cop : nat.coprime (int.nat_abs q_num) q_denom) =>
      idRhs (denom (-mk' q_num q_denom q_pos q_cop) = denom (-mk' q_num q_denom q_pos q_cop)) rfl

@[simp] theorem num_neg_eq_neg_num (q : ℚ) : num (-q) = -num q :=
  cases_on q
    fun (q_num : ℤ) (q_denom : ℕ) (q_pos : 0 < q_denom)
      (q_cop : nat.coprime (int.nat_abs q_num) q_denom) =>
      idRhs (num (-mk' q_num q_denom q_pos q_cop) = num (-mk' q_num q_denom q_pos q_cop)) rfl

@[simp] theorem num_zero : num 0 = 0 := rfl

theorem zero_of_num_zero {q : ℚ} (hq : num q = 0) : q = 0 := sorry

theorem zero_iff_num_zero {q : ℚ} : q = 0 ↔ num q = 0 := sorry

theorem num_ne_zero_of_ne_zero {q : ℚ} (h : q ≠ 0) : num q ≠ 0 :=
  fun (this : num q = 0) => h (zero_of_num_zero this)

@[simp] theorem num_one : num 1 = 1 := rfl

@[simp] theorem denom_one : denom 1 = 1 := rfl

theorem denom_ne_zero (q : ℚ) : denom q ≠ 0 := ne_of_gt (pos q)

theorem eq_iff_mul_eq_mul {p : ℚ} {q : ℚ} : p = q ↔ num p * ↑(denom q) = num q * ↑(denom p) := sorry

theorem mk_num_ne_zero_of_ne_zero {q : ℚ} {n : ℤ} {d : ℤ} (hq : q ≠ 0) (hqnd : q = mk n d) :
    n ≠ 0 :=
  sorry

theorem mk_denom_ne_zero_of_ne_zero {q : ℚ} {n : ℤ} {d : ℤ} (hq : q ≠ 0) (hqnd : q = mk n d) :
    d ≠ 0 :=
  sorry

theorem mk_ne_zero_of_ne_zero {n : ℤ} {d : ℤ} (h : n ≠ 0) (hd : d ≠ 0) : mk n d ≠ 0 :=
  fun (this : mk n d = 0) => h (iff.mp (mk_eq_zero hd) this)

theorem mul_num_denom (q : ℚ) (r : ℚ) : q * r = mk (num q * num r) ↑(denom q * denom r) := sorry

theorem div_num_denom (q : ℚ) (r : ℚ) : q / r = mk (num q * ↑(denom r)) (↑(denom q) * num r) :=
  sorry

theorem num_denom_mk {q : ℚ} {n : ℤ} {d : ℤ} (hn : n ≠ 0) (hd : d ≠ 0) (qdf : q = mk n d) :
    ∃ (c : ℤ), n = c * num q ∧ d = c * ↑(denom q) :=
  sorry

theorem mk_pnat_num (n : ℤ) (d : ℕ+) : num (mk_pnat n d) = n / ↑(nat.gcd (int.nat_abs n) ↑d) :=
  subtype.cases_on d
    fun (d_val : ℕ) (d_property : 0 < d_val) =>
      Eq.refl (num (mk_pnat n { val := d_val, property := d_property }))

theorem mk_pnat_denom (n : ℤ) (d : ℕ+) : denom (mk_pnat n d) = ↑d / nat.gcd (int.nat_abs n) ↑d :=
  subtype.cases_on d
    fun (d_val : ℕ) (d_property : 0 < d_val) =>
      Eq.refl (denom (mk_pnat n { val := d_val, property := d_property }))

theorem mul_num (q₁ : ℚ) (q₂ : ℚ) :
    num (q₁ * q₂) =
        num q₁ * num q₂ / ↑(nat.gcd (int.nat_abs (num q₁ * num q₂)) (denom q₁ * denom q₂)) :=
  sorry

theorem mul_denom (q₁ : ℚ) (q₂ : ℚ) :
    denom (q₁ * q₂) =
        denom q₁ * denom q₂ / nat.gcd (int.nat_abs (num q₁ * num q₂)) (denom q₁ * denom q₂) :=
  sorry

theorem mul_self_num (q : ℚ) : num (q * q) = num q * num q := sorry

theorem mul_self_denom (q : ℚ) : denom (q * q) = denom q * denom q := sorry

theorem add_num_denom (q : ℚ) (r : ℚ) :
    q + r = mk (num q * ↑(denom r) + ↑(denom q) * num r) (↑(denom q) * ↑(denom r)) :=
  sorry

theorem coe_int_eq_mk (z : ℤ) : ↑z = mk z 1 := sorry

theorem mk_eq_div (n : ℤ) (d : ℤ) : mk n d = ↑n / ↑d := sorry

theorem exists_eq_mul_div_num_and_eq_mul_div_denom {n : ℤ} {d : ℤ} (n_ne_zero : n ≠ 0)
    (d_ne_zero : d ≠ 0) : ∃ (c : ℤ), n = c * num (↑n / ↑d) ∧ d = c * ↑(denom (↑n / ↑d)) :=
  num_denom_mk n_ne_zero d_ne_zero
    (eq.mpr (id (Eq._oldrec (Eq.refl (↑n / ↑d = mk n d)) (Eq.symm (mk_eq_div n d))))
      (Eq.refl (mk n d)))

theorem coe_int_eq_of_int (z : ℤ) : ↑z = of_int z :=
  Eq.trans (coe_int_eq_mk z) (Eq.symm (of_int_eq_mk z))

@[simp] theorem coe_int_num (n : ℤ) : num ↑n = n :=
  eq.mpr (id (Eq._oldrec (Eq.refl (num ↑n = n)) (coe_int_eq_of_int n))) (Eq.refl (num (of_int n)))

@[simp] theorem coe_int_denom (n : ℤ) : denom ↑n = 1 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (denom ↑n = 1)) (coe_int_eq_of_int n)))
    (Eq.refl (denom (of_int n)))

theorem coe_int_num_of_denom_eq_one {q : ℚ} (hq : denom q = 1) : ↑(num q) = q := sorry

theorem denom_eq_one_iff (r : ℚ) : denom r = 1 ↔ ↑(num r) = r :=
  { mp := coe_int_num_of_denom_eq_one, mpr := fun (h : ↑(num r) = r) => h ▸ coe_int_denom (num r) }

protected instance int.can_lift : can_lift ℚ ℤ := can_lift.mk coe (fun (q : ℚ) => denom q = 1) sorry

theorem coe_nat_eq_mk (n : ℕ) : ↑n = mk (↑n) 1 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (↑n = mk (↑n) 1)) (Eq.symm (int.cast_coe_nat n))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (↑↑n = mk (↑n) 1)) (coe_int_eq_mk ↑n))) (Eq.refl (mk (↑n) 1)))

@[simp] theorem coe_nat_num (n : ℕ) : num ↑n = ↑n :=
  eq.mpr (id (Eq._oldrec (Eq.refl (num ↑n = ↑n)) (Eq.symm (int.cast_coe_nat n))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (num ↑↑n = ↑n)) (coe_int_num ↑n))) (Eq.refl ↑n))

@[simp] theorem coe_nat_denom (n : ℕ) : denom ↑n = 1 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (denom ↑n = 1)) (Eq.symm (int.cast_coe_nat n))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (denom ↑↑n = 1)) (coe_int_denom ↑n))) (Eq.refl 1))

-- Will be subsumed by `int.coe_inj` after we have defined

-- `linear_ordered_field ℚ` (which implies characteristic zero).

theorem coe_int_inj (m : ℤ) (n : ℤ) : ↑m = ↑n ↔ m = n := sorry

theorem inv_def' {q : ℚ} : q⁻¹ = ↑(denom q) / ↑(num q) := sorry

@[simp] theorem mul_denom_eq_num {q : ℚ} : q * ↑(denom q) = ↑(num q) := sorry

theorem denom_div_cast_eq_one_iff (m : ℤ) (n : ℤ) (hn : n ≠ 0) : denom (↑m / ↑n) = 1 ↔ n ∣ m :=
  sorry

theorem num_div_eq_of_coprime {a : ℤ} {b : ℤ} (hb0 : 0 < b)
    (h : nat.coprime (int.nat_abs a) (int.nat_abs b)) : num (↑a / ↑b) = a :=
  sorry

theorem denom_div_eq_of_coprime {a : ℤ} {b : ℤ} (hb0 : 0 < b)
    (h : nat.coprime (int.nat_abs a) (int.nat_abs b)) : ↑(denom (↑a / ↑b)) = b :=
  sorry

theorem div_int_inj {a : ℤ} {b : ℤ} {c : ℤ} {d : ℤ} (hb0 : 0 < b) (hd0 : 0 < d)
    (h1 : nat.coprime (int.nat_abs a) (int.nat_abs b))
    (h2 : nat.coprime (int.nat_abs c) (int.nat_abs d)) (h : ↑a / ↑b = ↑c / ↑d) : a = c ∧ b = d :=
  sorry

theorem coe_int_div_self (n : ℤ) : ↑(n / n) = ↑n / ↑n := sorry

theorem coe_nat_div_self (n : ℕ) : ↑(n / n) = ↑n / ↑n := coe_int_div_self ↑n

theorem coe_int_div (a : ℤ) (b : ℤ) (h : b ∣ a) : ↑(a / b) = ↑a / ↑b := sorry

theorem coe_nat_div (a : ℕ) (b : ℕ) (h : b ∣ a) : ↑(a / b) = ↑a / ↑b := sorry

protected theorem forall {p : ℚ → Prop} : (∀ (r : ℚ), p r) ↔ ∀ (a b : ℤ), p (↑a / ↑b) := sorry

protected theorem exists {p : ℚ → Prop} : (∃ (r : ℚ), p r) ↔ ∃ (a : ℤ), ∃ (b : ℤ), p (↑a / ↑b) :=
  sorry

end Mathlib