/-
Copyright (c) 2019 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau, Johan Commelin
-/
import data.equiv.functor
import data.mv_polynomial.equiv
import data.mv_polynomial.comm_ring
import ring_theory.free_ring

/-!
# Free commutative rings

The theory of the free commutative ring generated by a type `α`.
It is isomorphic to the polynomial ring over ℤ with variables
in `α`

## Main definitions

* `free_comm_ring α`     : the free commutative ring on a type α
* `lift (f : α → R)` : the ring hom `free_comm_ring α →+* R` induced by functoriality from `f`.
* `map (f : α → β)`      : the ring hom `free_comm_ring α →*+ free_comm_ring β` induced by
                           functoriality from f.

## Main results

`free_comm_ring` has functorial properties (it is an adjoint to the forgetful functor).
In this file we have:

* `of : α → free_comm_ring α`
* `lift (f : α → R) : free_comm_ring α →+* R`
* `map (f : α → β) : free_comm_ring α →+* free_comm_ring β`

* `free_comm_ring_equiv_mv_polynomial_int : free_comm_ring α ≃+* mv_polynomial α ℤ` :
    `free_comm_ring α` is isomorphic to a polynomial ring.

## Implementation notes

`free_comm_ring α` is implemented not using `mv_polynomial` but
directly as the free abelian group on `multiset α`, the type
of monomials in this free commutative ring.

## Tags

free commutative ring, free ring
-/

noncomputable theory
open_locale classical

universes u v

variables (α : Type u)

/-- `free_comm_ring α` is the free commutative ring on the type `α`. -/
@[derive [comm_ring, inhabited]]
def free_comm_ring (α : Type u) : Type u :=
free_abelian_group $ multiplicative $ multiset α

namespace free_comm_ring

variables {α}

/-- The canonical map from `α` to the free commutative ring on `α`. -/
def of (x : α) : free_comm_ring α :=
free_abelian_group.of $ multiplicative.of_add ({x} : multiset α)

lemma of_injective : function.injective (of : α → free_comm_ring α) :=
free_abelian_group.of_injective.comp (λ x y,
  (multiset.coe_eq_coe.trans list.singleton_perm_singleton).mp)

@[elab_as_eliminator] protected lemma induction_on
  {C : free_comm_ring α → Prop} (z : free_comm_ring α)
  (hn1 : C (-1)) (hb : ∀ b, C (of b))
  (ha : ∀ x y, C x → C y → C (x + y))
  (hm : ∀ x y, C x → C y → C (x * y)) : C z :=
have hn : ∀ x, C x → C (-x), from λ x ih, neg_one_mul x ▸ hm _ _ hn1 ih,
have h1 : C 1, from neg_neg (1 : free_comm_ring α) ▸ hn _ hn1,
free_abelian_group.induction_on z
  (add_left_neg (1 : free_comm_ring α) ▸ ha _ _ hn1 h1)
  (λ m, multiset.induction_on m h1 $ λ a m ih, hm _ _ (hb a) ih)
  (λ m ih, hn _ ih)
  ha
section lift

variables {R : Type v} [comm_ring R] (f : α → R)

/-- A helper to implement `lift`. This is essentially `free_comm_monoid.lift`, but this does not
currently exist. -/
private def lift_to_multiset : (α → R) ≃ (multiplicative (multiset α) →* R) :=
{ to_fun := λ f,
  { to_fun := λ s, (s.to_add.map f).prod,
    map_mul' := λ x y, calc _ = multiset.prod ((multiset.map f x) + (multiset.map f y)) :
                                    by {congr' 1, exact multiset.map_add _ _ _}
                          ... = _ : multiset.prod_add _ _,
    map_one' := rfl},
  inv_fun := λ F x, F (multiplicative.of_add ({x} : multiset α)),
  left_inv := λ f, funext $ λ x, show (multiset.map f (x ::ₘ 0)).prod = _, by simp,
  right_inv := λ F, monoid_hom.ext $ λ x,
    let F' := F.to_additive'', x' := x.to_add in show (multiset.map (λ a, F' {a}) x').sum = F' x',
    begin
      rw [←multiset.map_map, ←add_monoid_hom.map_multiset_sum],
      exact F.congr_arg (multiset.sum_map_singleton x'),
    end }

/-- Lift a map `α → R` to a additive group homomorphism `free_comm_ring α → R`.
For a version producing a bundled homomorphism, see `lift_hom`. -/
def lift : (α → R) ≃ (free_comm_ring α →+* R) :=
equiv.trans lift_to_multiset free_abelian_group.lift_monoid

@[simp] lemma lift_of (x : α) : lift f (of x) = f x :=
(free_abelian_group.lift.of _ _).trans $ mul_one _

@[simp] lemma lift_comp_of (f : free_comm_ring α →+* R) : lift (f ∘ of) = f :=
ring_hom.ext $ λ x, free_comm_ring.induction_on x
  (by rw [ring_hom.map_neg, ring_hom.map_one, f.map_neg, f.map_one])
  (lift_of _)
  (λ x y ihx ihy, by rw [ring_hom.map_add, f.map_add, ihx, ihy])
  (λ x y ihx ihy, by rw [ring_hom.map_mul, f.map_mul, ihx, ihy])

@[ext]
lemma hom_ext ⦃f g : free_comm_ring α →+* R⦄ (h : ∀ x, f (of x) = g (of x)) :
  f = g :=
lift.symm.injective (funext h)

end lift

variables {β : Type v} (f : α → β)

/-- A map `f : α → β` produces a ring homomorphism `free_comm_ring α →+* free_comm_ring β`. -/
def map : free_comm_ring α →+* free_comm_ring β :=
lift $ of ∘ f

@[simp]
lemma map_of (x : α) : map f (of x) = of (f x) := lift_of _ _

/-- `is_supported x s` means that all monomials showing up in `x` have variables in `s`. -/
def is_supported (x : free_comm_ring α) (s : set α) : Prop :=
x ∈ ring.closure (of '' s)

section is_supported
variables {x y : free_comm_ring α} {s t : set α}

theorem is_supported_upwards (hs : is_supported x s) (hst : s ⊆ t) :
  is_supported x t :=
ring.closure_mono (set.monotone_image hst) hs

theorem is_supported_add (hxs : is_supported x s) (hys : is_supported y s) :
  is_supported (x + y) s :=
is_add_submonoid.add_mem hxs hys

theorem is_supported_neg (hxs : is_supported x s) :
  is_supported (-x) s :=
is_add_subgroup.neg_mem hxs

theorem is_supported_sub (hxs : is_supported x s) (hys : is_supported y s) :
  is_supported (x - y) s :=
is_add_subgroup.sub_mem hxs hys

theorem is_supported_mul (hxs : is_supported x s) (hys : is_supported y s) :
  is_supported (x * y) s :=
is_submonoid.mul_mem hxs hys

theorem is_supported_zero : is_supported 0 s :=
is_add_submonoid.zero_mem

theorem is_supported_one : is_supported 1 s :=
is_submonoid.one_mem

theorem is_supported_int {i : ℤ} {s : set α} : is_supported ↑i s :=
int.induction_on i is_supported_zero
  (λ i hi, by rw [int.cast_add, int.cast_one]; exact is_supported_add hi is_supported_one)
  (λ i hi, by rw [int.cast_sub, int.cast_one]; exact is_supported_sub hi is_supported_one)

end is_supported

/-- The restriction map from `free_comm_ring α` to `free_comm_ring s` where `s : set α`, defined
  by sending all variables not in `s` to zero. -/
def restriction (s : set α) [decidable_pred s] : free_comm_ring α →+* free_comm_ring s :=
lift (λ p, if H : p ∈ s then of (⟨p, H⟩ : s) else 0)

section restriction
variables (s : set α) [decidable_pred s] (x y : free_comm_ring α)
@[simp] lemma restriction_of (p) :
  restriction s (of p) = if H : p ∈ s then of ⟨p, H⟩ else 0 := lift_of _ _

end restriction

theorem is_supported_of {p} {s : set α} : is_supported (of p) s ↔ p ∈ s :=
suffices is_supported (of p) s → p ∈ s, from ⟨this, λ hps, ring.subset_closure ⟨p, hps, rfl⟩⟩,
assume hps : is_supported (of p) s, begin
  haveI := classical.dec_pred s,
  have : ∀ x, is_supported x s →
    ∃ (n : ℤ), lift (λ a, if a ∈ s then (0 : polynomial ℤ) else polynomial.X) x = n,
  { intros x hx, refine ring.in_closure.rec_on hx _ _ _ _,
    { use 1, rw [ring_hom.map_one], norm_cast },
    { use -1, rw [ring_hom.map_neg, ring_hom.map_one], norm_cast },
    { rintros _ ⟨z, hzs, rfl⟩ _ _, use 0, rw [ring_hom.map_mul, lift_of, if_pos hzs, zero_mul],
      norm_cast },
    { rintros x y ⟨q, hq⟩ ⟨r, hr⟩, refine ⟨q+r, _⟩, rw [ring_hom.map_add, hq, hr], norm_cast } },
  specialize this (of p) hps, rw [lift_of] at this, split_ifs at this, { exact h },
  exfalso, apply ne.symm int.zero_ne_one,
  rcases this with ⟨w, H⟩, rw ←polynomial.C_eq_int_cast at H,
  have : polynomial.X.coeff 1 = (polynomial.C ↑w).coeff 1, by rw H,
  rwa [polynomial.coeff_C, if_neg (one_ne_zero : 1 ≠ 0), polynomial.coeff_X, if_pos rfl] at this
end

theorem map_subtype_val_restriction {x} (s : set α) [decidable_pred s] (hxs : is_supported x s) :
  map (subtype.val : s → α) (restriction s x) = x :=
begin
  refine ring.in_closure.rec_on hxs _ _ _ _,
  { rw ring_hom.map_one, refl },
  { rw [ring_hom.map_neg, ring_hom.map_neg, ring_hom.map_one], refl },
  { rintros _ ⟨p, hps, rfl⟩ n ih,
    rw [ring_hom.map_mul, restriction_of, dif_pos hps, ring_hom.map_mul, map_of, ih] },
  { intros x y ihx ihy, rw [ring_hom.map_add, ring_hom.map_add, ihx, ihy] }
end

theorem exists_finite_support (x : free_comm_ring α) :
  ∃ s : set α, set.finite s ∧ is_supported x s :=
free_comm_ring.induction_on x
  ⟨∅, set.finite_empty, is_supported_neg is_supported_one⟩
  (λ p, ⟨{p}, set.finite_singleton p, is_supported_of.2 $ set.mem_singleton _⟩)
  (λ x y ⟨s, hfs, hxs⟩ ⟨t, hft, hxt⟩, ⟨s ∪ t, hfs.union hft, is_supported_add
    (is_supported_upwards hxs $ set.subset_union_left s t)
    (is_supported_upwards hxt $ set.subset_union_right s t)⟩)
  (λ x y ⟨s, hfs, hxs⟩ ⟨t, hft, hxt⟩, ⟨s ∪ t, hfs.union hft, is_supported_mul
    (is_supported_upwards hxs $ set.subset_union_left s t)
    (is_supported_upwards hxt $ set.subset_union_right s t)⟩)

theorem exists_finset_support (x : free_comm_ring α) : ∃ s : finset α, is_supported x ↑s :=
let ⟨s, hfs, hxs⟩ := exists_finite_support x in ⟨hfs.to_finset, by rwa set.finite.coe_to_finset⟩

end free_comm_ring

namespace free_ring
open function
variable (α)

/-- The canonical ring homomorphism from the free ring generated by `α` to the free commutative ring
    generated by `α`. -/
def to_free_comm_ring {α} : free_ring α →+* free_comm_ring α :=
free_ring.lift free_comm_ring.of

instance : has_coe (free_ring α) (free_comm_ring α) := ⟨to_free_comm_ring⟩

instance coe.is_ring_hom : is_ring_hom (coe : free_ring α → free_comm_ring α) :=
free_ring.to_free_comm_ring.is_ring_hom

@[simp, norm_cast] protected lemma coe_zero : ↑(0 : free_ring α) = (0 : free_comm_ring α) := rfl
@[simp, norm_cast] protected lemma coe_one : ↑(1 : free_ring α) = (1 : free_comm_ring α) := rfl

variable {α}

@[simp] protected lemma coe_of (a : α) : ↑(free_ring.of a) = free_comm_ring.of a :=
free_ring.lift_of _ _
@[simp, norm_cast] protected lemma coe_neg (x : free_ring α) : ↑(-x) = -(x : free_comm_ring α) :=
(free_ring.lift _).map_neg _
@[simp, norm_cast] protected lemma coe_add (x y : free_ring α) :
  ↑(x + y) = (x : free_comm_ring α) + y :=
(free_ring.lift _).map_add _ _
@[simp, norm_cast] protected lemma coe_sub (x y : free_ring α) :
  ↑(x - y) = (x : free_comm_ring α) - y :=
(free_ring.lift _).map_sub _ _
@[simp, norm_cast] protected lemma coe_mul (x y : free_ring α) :
  ↑(x * y) = (x : free_comm_ring α) * y :=
(free_ring.lift _).map_mul _ _

variable (α)

protected lemma coe_surjective : surjective (coe : free_ring α → free_comm_ring α) :=
λ x,
begin
  apply free_comm_ring.induction_on x,
  { use -1, refl },
  { intro x, use free_ring.of x, refl },
  { rintros _ _ ⟨x, rfl⟩ ⟨y, rfl⟩, use x + y, exact (free_ring.lift _).map_add _ _ },
  { rintros _ _ ⟨x, rfl⟩ ⟨y, rfl⟩, use x * y, exact (free_ring.lift _).map_mul _ _ }
end

lemma coe_eq :
  (coe : free_ring α → free_comm_ring α) =
  @functor.map free_abelian_group _ _ _ (λ (l : list α), (l : multiset α)) :=
funext $ λ x, free_abelian_group.lift.unique _ _ $ λ L,
by { simp_rw [free_abelian_group.lift.of, (∘)], exact free_monoid.rec_on L rfl
(λ hd tl ih, by { rw [(free_monoid.lift _).map_mul, free_monoid.lift_eval_of, ih], refl }) }

-- FIXME This was in `deprecated.ring`, but only used here.
-- It would be good to inline it into the next construction.
/-- Interpret an equivalence `f : R ≃ S` as a ring equivalence `R ≃+* S`. -/
def of' {R S : Type*} [ring R] [ring S] (e : R ≃ S) [is_ring_hom e] : R ≃+* S :=
{ .. e, .. monoid_hom.of e, .. add_monoid_hom.of e }

/-- If α has size at most 1 then the natural map from the free ring on `α` to the
    free commutative ring on `α` is an isomorphism of rings. -/
def subsingleton_equiv_free_comm_ring [subsingleton α] :
  free_ring α ≃+* free_comm_ring α :=
@of' (free_ring α) (free_comm_ring α) _ _
  (functor.map_equiv free_abelian_group (multiset.subsingleton_equiv α)) $
  begin
    delta functor.map_equiv,
    rw congr_arg is_ring_hom _,
    work_on_goal 2 { symmetry, exact coe_eq α },
    apply_instance
  end

instance [subsingleton α] : comm_ring (free_ring α) :=
{ mul_comm := λ x y,
  by { rw [← (subsingleton_equiv_free_comm_ring α).symm_apply_apply (y * x),
        ((subsingleton_equiv_free_comm_ring α)).map_mul,
        mul_comm,
        ← ((subsingleton_equiv_free_comm_ring α)).map_mul,
        (subsingleton_equiv_free_comm_ring α).symm_apply_apply], },
  .. free_ring.ring α }

end free_ring

/-- The free commutative ring on `α` is isomorphic to the polynomial ring over ℤ with
    variables in `α` -/
def free_comm_ring_equiv_mv_polynomial_int :
  free_comm_ring α ≃+* mv_polynomial α ℤ :=
ring_equiv.of_hom_inv
  (free_comm_ring.lift $ λ a, mv_polynomial.X a)
  (mv_polynomial.eval₂_hom (int.cast_ring_hom (free_comm_ring α)) free_comm_ring.of)
  (by { ext, simp })
  (by ext; simp )

/-- The free commutative ring on the empty type is isomorphic to `ℤ`. -/
def free_comm_ring_pempty_equiv_int : free_comm_ring pempty.{u+1} ≃+* ℤ :=
ring_equiv.trans (free_comm_ring_equiv_mv_polynomial_int _) (mv_polynomial.pempty_ring_equiv _)

/-- The free commutative ring on a type with one term is isomorphic to `ℤ[X]`. -/
def free_comm_ring_punit_equiv_polynomial_int : free_comm_ring punit.{u+1} ≃+* polynomial ℤ :=
(free_comm_ring_equiv_mv_polynomial_int _).trans (mv_polynomial.punit_alg_equiv ℤ).to_ring_equiv

open free_ring

/-- The free ring on the empty type is isomorphic to `ℤ`. -/
def free_ring_pempty_equiv_int : free_ring pempty.{u+1} ≃+* ℤ :=
ring_equiv.trans (subsingleton_equiv_free_comm_ring _) free_comm_ring_pempty_equiv_int

/-- The free ring on a type with one term is isomorphic to `ℤ[X]`. -/
def free_ring_punit_equiv_polynomial_int : free_ring punit.{u+1} ≃+* polynomial ℤ :=
ring_equiv.trans (subsingleton_equiv_free_comm_ring _) free_comm_ring_punit_equiv_polynomial_int


/-
Copyright (c) 2020 Paul van Wamelen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Paul van Wamelen.
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.number_theory.pythagorean_triples
import Mathlib.ring_theory.coprime
import Mathlib.PostPort

namespace Mathlib

/-!
# Fermat's Last Theorem for the case n = 4
There are no non-zero integers `a`, `b` and `c` such that `a ^ 4 + b ^ 4 = c ^ 4`.
-/

/-- Shorthand for three non-zero integers `a`, `b`, and `c` satisfying `a ^ 4 + b ^ 4 = c ^ 2`.
We will show that no integers satisfy this equation. Clearly Fermat's Last theorem for n = 4
follows. -/
def fermat_42 (a : ℤ) (b : ℤ) (c : ℤ) :=
  a ≠ 0 ∧ b ≠ 0 ∧ a ^ bit0 (bit0 1) + b ^ bit0 (bit0 1) = c ^ bit0 1

namespace fermat_42

theorem comm {a : ℤ} {b : ℤ} {c : ℤ} : fermat_42 a b c ↔ fermat_42 b a c := sorry

theorem mul {a : ℤ} {b : ℤ} {c : ℤ} {k : ℤ} (hk0 : k ≠ 0) :
    fermat_42 a b c ↔ fermat_42 (k * a) (k * b) (k ^ bit0 1 * c) :=
  sorry

theorem ne_zero {a : ℤ} {b : ℤ} {c : ℤ} (h : fermat_42 a b c) : c ≠ 0 := sorry

/-- We say a solution to `a ^ 4 + b ^ 4 = c ^ 2` is minimal if there is no other solution with
a smaller `c` (in absolute value). -/
def minimal (a : ℤ) (b : ℤ) (c : ℤ) :=
  fermat_42 a b c ∧ ∀ (a1 b1 c1 : ℤ), fermat_42 a1 b1 c1 → int.nat_abs c ≤ int.nat_abs c1

/-- if we have a solution to `a ^ 4 + b ^ 4 = c ^ 2` then there must be a minimal one. -/
theorem exists_minimal {a : ℤ} {b : ℤ} {c : ℤ} (h : fermat_42 a b c) :
    ∃ (a0 : ℤ), ∃ (b0 : ℤ), ∃ (c0 : ℤ), minimal a0 b0 c0 :=
  sorry

/-- a minimal solution to `a ^ 4 + b ^ 4 = c ^ 2` must have `a` and `b` coprime. -/
theorem coprime_of_minimal {a : ℤ} {b : ℤ} {c : ℤ} (h : minimal a b c) : is_coprime a b := sorry

/-- We can swap `a` and `b` in a minimal solution to `a ^ 4 + b ^ 4 = c ^ 2`. -/
theorem minimal_comm {a : ℤ} {b : ℤ} {c : ℤ} : minimal a b c → minimal b a c := sorry

/-- We can assume that a minimal solution to `a ^ 4 + b ^ 4 = c ^ 2` has positive `c`. -/
theorem neg_of_minimal {a : ℤ} {b : ℤ} {c : ℤ} : minimal a b c → minimal a b (-c) := sorry

/-- We can assume that a minimal solution to `a ^ 4 + b ^ 4 = c ^ 2` has `a` odd. -/
theorem exists_odd_minimal {a : ℤ} {b : ℤ} {c : ℤ} (h : fermat_42 a b c) :
    ∃ (a0 : ℤ), ∃ (b0 : ℤ), ∃ (c0 : ℤ), minimal a0 b0 c0 ∧ a0 % bit0 1 = 1 :=
  sorry

/-- We can assume that a minimal solution to `a ^ 4 + b ^ 4 = c ^ 2` has
`a` odd and `c` positive. -/
theorem exists_pos_odd_minimal {a : ℤ} {b : ℤ} {c : ℤ} (h : fermat_42 a b c) :
    ∃ (a0 : ℤ), ∃ (b0 : ℤ), ∃ (c0 : ℤ), minimal a0 b0 c0 ∧ a0 % bit0 1 = 1 ∧ 0 < c0 :=
  sorry

end fermat_42

theorem int.coprime_of_sqr_sum {r : ℤ} {s : ℤ} (h2 : is_coprime s r) :
    is_coprime (r ^ bit0 1 + s ^ bit0 1) r :=
  eq.mpr (id (Eq._oldrec (Eq.refl (is_coprime (r ^ bit0 1 + s ^ bit0 1) r)) (pow_two r)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (is_coprime (r * r + s ^ bit0 1) r)) (pow_two s)))
      (is_coprime.mul_add_left_left (is_coprime.mul_left h2 h2) r))

theorem int.coprime_of_sqr_sum' {r : ℤ} {s : ℤ} (h : is_coprime r s) :
    is_coprime (r ^ bit0 1 + s ^ bit0 1) (r * s) :=
  is_coprime.mul_right (int.coprime_of_sqr_sum (iff.mp is_coprime_comm h))
    (eq.mpr
      (id
        (Eq._oldrec (Eq.refl (is_coprime (r ^ bit0 1 + s ^ bit0 1) s))
          (add_comm (r ^ bit0 1) (s ^ bit0 1))))
      (int.coprime_of_sqr_sum h))

namespace fermat_42

-- If we have a solution to a ^ 4 + b ^ 4 = c ^ 2, we can construct a smaller one. This

-- implies there can't be a smallest solution.

theorem not_minimal {a : ℤ} {b : ℤ} {c : ℤ} (h : minimal a b c) (ha2 : a % bit0 1 = 1)
    (hc : 0 < c) : False :=
  sorry

end fermat_42

theorem not_fermat_42 {a : ℤ} {b : ℤ} {c : ℤ} (ha : a ≠ 0) (hb : b ≠ 0) :
    a ^ bit0 (bit0 1) + b ^ bit0 (bit0 1) ≠ c ^ bit0 1 :=
  sorry

theorem not_fermat_4 {a : ℤ} {b : ℤ} {c : ℤ} (ha : a ≠ 0) (hb : b ≠ 0) :
    a ^ bit0 (bit0 1) + b ^ bit0 (bit0 1) ≠ c ^ bit0 (bit0 1) :=
  sorry

end Mathlib


/-
Copyright (c) 2018 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Callum Sutton, Yury Kudryashov
-/
import algebra.group.type_tags
import algebra.group_with_zero.basic
import data.pi

/-!
# Multiplicative and additive equivs

In this file we define two extensions of `equiv` called `add_equiv` and `mul_equiv`, which are
datatypes representing isomorphisms of `add_monoid`s/`add_group`s and `monoid`s/`group`s.

## Notations

* ``infix ` ≃* `:25 := mul_equiv``
* ``infix ` ≃+ `:25 := add_equiv``

The extended equivs all have coercions to functions, and the coercions are the canonical
notation when treating the isomorphisms as maps.

## Implementation notes

The fields for `mul_equiv`, `add_equiv` now avoid the unbundled `is_mul_hom` and `is_add_hom`, as
these are deprecated.

## Tags

equiv, mul_equiv, add_equiv
-/

variables {F α β A B M N P Q G H : Type*}

/-- Makes a multiplicative inverse from a bijection which preserves multiplication. -/
@[to_additive "Makes an additive inverse from a bijection which preserves addition."]
def mul_hom.inverse [has_mul M] [has_mul N] (f : mul_hom M N) (g : N → M)
  (h₁ : function.left_inverse g f) (h₂ : function.right_inverse g f) : mul_hom N M :=
{ to_fun   := g,
  map_mul' := λ x y,
    calc g (x * y) = g (f (g x) * f (g y)) : by rw [h₂ x, h₂ y]
               ... = g (f (g x * g y)) : by rw f.map_mul
               ... = g x * g y : h₁ _, }

/-- The inverse of a bijective `monoid_hom` is a `monoid_hom`. -/
@[to_additive "The inverse of a bijective `add_monoid_hom` is an `add_monoid_hom`.", simps]
def monoid_hom.inverse {A B : Type*} [monoid A] [monoid B] (f : A →* B) (g : B → A)
  (h₁ : function.left_inverse g f) (h₂ : function.right_inverse g f) :
  B →* A :=
{ to_fun   := g,
  map_one' := by rw [← f.map_one, h₁],
  .. (f : mul_hom A B).inverse g h₁ h₂, }

set_option old_structure_cmd true

/-- add_equiv α β is the type of an equiv α ≃ β which preserves addition. -/
@[ancestor equiv add_hom]
structure add_equiv (A B : Type*) [has_add A] [has_add B] extends A ≃ B, add_hom A B

/-- `add_equiv_class F A B` states that `F` is a type of addition-preserving morphisms.
You should extend this class when you extend `add_equiv`. -/
class add_equiv_class (F A B : Type*) [has_add A] [has_add B]
  extends equiv_like F A B :=
(map_add : ∀ (f : F) a b, f (a + b) = f a + f b)

/-- The `equiv` underlying an `add_equiv`. -/
add_decl_doc add_equiv.to_equiv
/-- The `add_hom` underlying a `add_equiv`. -/
add_decl_doc add_equiv.to_add_hom

/-- `mul_equiv α β` is the type of an equiv `α ≃ β` which preserves multiplication. -/
@[ancestor equiv mul_hom, to_additive]
structure mul_equiv (M N : Type*) [has_mul M] [has_mul N] extends M ≃ N, mul_hom M N

/-- The `equiv` underlying a `mul_equiv`. -/
add_decl_doc mul_equiv.to_equiv
/-- The `mul_hom` underlying a `mul_equiv`. -/
add_decl_doc mul_equiv.to_mul_hom

/-- `mul_equiv_class F A B` states that `F` is a type of multiplication-preserving morphisms.
You should extend this class when you extend `mul_equiv`. -/
@[to_additive]
class mul_equiv_class (F A B : Type*) [has_mul A] [has_mul B]
  extends equiv_like F A B :=
(map_mul : ∀ (f : F) a b, f (a * b) = f a * f b)

infix ` ≃* `:25 := mul_equiv
infix ` ≃+ `:25 := add_equiv

namespace mul_equiv_class
variables (F)

@[priority 100, -- See note [lower instance priority]
  to_additive]
instance [has_mul M] [has_mul N] [h : mul_equiv_class F M N] : mul_hom_class F M N :=
{ coe := (coe : F → M → N),
  coe_injective' := @fun_like.coe_injective F _ _ _,
  .. h }

@[priority 100, -- See note [lower instance priority]
  to_additive]
instance [mul_one_class M] [mul_one_class N] [mul_equiv_class F M N] :
  monoid_hom_class F M N :=
{ coe := (coe : F → M → N),
  map_one := λ e,
  calc e 1 = e 1 * 1 : (mul_one _).symm
       ... = e 1 * e (inv e (1 : N) : M) : congr_arg _ (right_inv e 1).symm
       ... = e (inv e (1 : N)) : by rw [← map_mul, one_mul]
       ... = 1 : right_inv e 1,
  .. mul_equiv_class.mul_hom_class F }

@[priority 100] -- See note [lower instance priority]
instance to_monoid_with_zero_hom_class {α β : Type*} [mul_zero_one_class α]
  [mul_zero_one_class β] [mul_equiv_class F α β] : monoid_with_zero_hom_class F α β :=
{ map_zero := λ e, calc e 0 = e 0 * e (equiv_like.inv e 0) : by rw [←map_mul, zero_mul]
                        ... = 0 : by { convert mul_zero _, exact equiv_like.right_inv e _ }
  ..mul_equiv_class.monoid_hom_class _ }

variables {F}

@[simp, to_additive]
lemma map_eq_one_iff {M N} [mul_one_class M] [mul_one_class N] [mul_equiv_class F M N]
  (h : F) {x : M} : h x = 1 ↔ x = 1 :=
map_eq_one_iff h (equiv_like.injective h)

@[to_additive]
lemma map_ne_one_iff {M N} [mul_one_class M] [mul_one_class N] [mul_equiv_class F M N]
  (h : F) {x : M} :
  h x ≠ 1 ↔ x ≠ 1 :=
map_ne_one_iff h (equiv_like.injective h)

end mul_equiv_class

@[to_additive] instance [has_mul α] [has_mul β] [mul_equiv_class F α β] : has_coe_t F (α ≃* β) :=
⟨λ f, { to_fun := f, inv_fun := equiv_like.inv f, left_inv := equiv_like.left_inv f,
  right_inv := equiv_like.right_inv f, map_mul' := map_mul f }⟩

namespace mul_equiv

@[to_additive]
instance [has_mul M] [has_mul N] : has_coe_to_fun (M ≃* N) (λ _, M → N) := ⟨mul_equiv.to_fun⟩

@[to_additive]
instance [has_mul M] [has_mul N] : mul_equiv_class (M ≃* N) M N :=
{ coe := to_fun, inv := inv_fun, left_inv := left_inv, right_inv := right_inv,
  coe_injective' := λ f g h₁ h₂, by { cases f, cases g, congr' },
  map_mul := map_mul' }

variables [has_mul M] [has_mul N] [has_mul P] [has_mul Q]

@[simp, to_additive]
lemma to_equiv_eq_coe (f : M ≃* N) : f.to_equiv = f := rfl

@[simp, to_additive]
lemma to_fun_eq_coe {f : M ≃* N} : f.to_fun = f := rfl

@[simp, to_additive]
lemma coe_to_equiv {f : M ≃* N} : ⇑(f : M ≃ N) = f := rfl

@[simp, to_additive]
lemma coe_to_mul_hom {f : M ≃* N} : ⇑f.to_mul_hom = f := rfl

/-- A multiplicative isomorphism preserves multiplication. -/
@[to_additive "An additive isomorphism preserves addition."]
protected lemma map_mul (f : M ≃* N) : ∀ x y, f (x * y) = f x * f y := map_mul f

/-- Makes a multiplicative isomorphism from a bijection which preserves multiplication. -/
@[to_additive "Makes an additive isomorphism from a bijection which preserves addition."]
def mk' (f : M ≃ N) (h : ∀ x y, f (x * y) = f x * f y) : M ≃* N :=
⟨f.1, f.2, f.3, f.4, h⟩

@[to_additive]
protected lemma bijective (e : M ≃* N) : function.bijective e := equiv_like.bijective e

@[to_additive]
protected lemma injective (e : M ≃* N) : function.injective e := equiv_like.injective e

@[to_additive]
protected lemma surjective (e : M ≃* N) : function.surjective e := equiv_like.surjective e

/-- The identity map is a multiplicative isomorphism. -/
@[refl, to_additive "The identity map is an additive isomorphism."]
def refl (M : Type*) [has_mul M] : M ≃* M :=
{ map_mul' := λ _ _, rfl,
..equiv.refl _}

@[to_additive]
instance : inhabited (M ≃* M) := ⟨refl M⟩

/-- The inverse of an isomorphism is an isomorphism. -/
@[symm, to_additive "The inverse of an isomorphism is an isomorphism."]
def symm (h : M ≃* N) : N ≃* M :=
{ map_mul' := (h.to_mul_hom.inverse h.to_equiv.symm h.left_inv h.right_inv).map_mul,
  .. h.to_equiv.symm}

@[simp, to_additive]
lemma inv_fun_eq_symm {f : M ≃* N} : f.inv_fun = f.symm := rfl

/-- See Note [custom simps projection] -/
-- we don't hyperlink the note in the additive version, since that breaks syntax highlighting
-- in the whole file.
@[to_additive "See Note custom simps projection"]
def simps.symm_apply (e : M ≃* N) : N → M := e.symm

initialize_simps_projections add_equiv (to_fun → apply, inv_fun → symm_apply)
initialize_simps_projections mul_equiv (to_fun → apply, inv_fun → symm_apply)

@[simp, to_additive]
theorem to_equiv_symm (f : M ≃* N) : f.symm.to_equiv = f.to_equiv.symm := rfl

@[simp, to_additive]
theorem coe_mk (f : M → N) (g h₁ h₂ h₃) : ⇑(mul_equiv.mk f g h₁ h₂ h₃) = f := rfl

@[simp, to_additive]
lemma to_equiv_mk (f : M → N) (g : N → M) (h₁ h₂ h₃) :
  (mk f g h₁ h₂ h₃).to_equiv = ⟨f, g, h₁, h₂⟩ := rfl

@[simp, to_additive]
lemma symm_symm : ∀ (f : M ≃* N), f.symm.symm = f
| ⟨f, g, h₁, h₂, h₃⟩ := rfl

@[to_additive]
lemma symm_bijective : function.bijective (symm : (M ≃* N) → (N ≃* M)) :=
equiv.bijective ⟨symm, symm, symm_symm, symm_symm⟩

@[simp, to_additive]
theorem symm_mk (f : M → N) (g h₁ h₂ h₃) :
  (mul_equiv.mk f g h₁ h₂ h₃).symm =
  { to_fun := g, inv_fun := f, ..(mul_equiv.mk f g h₁ h₂ h₃).symm} := rfl

/-- Transitivity of multiplication-preserving isomorphisms -/
@[trans, to_additive "Transitivity of addition-preserving isomorphisms"]
def trans (h1 : M ≃* N) (h2 : N ≃* P) : (M ≃* P) :=
{ map_mul' := λ x y, show h2 (h1 (x * y)) = h2 (h1 x) * h2 (h1 y),
    by rw [h1.map_mul, h2.map_mul],
  ..h1.to_equiv.trans h2.to_equiv }

/-- `e.symm` is a right inverse of `e`, written as `e (e.symm y) = y`. -/
@[simp, to_additive "`e.symm` is a right inverse of `e`, written as `e (e.symm y) = y`."]
lemma apply_symm_apply (e : M ≃* N) (y : N) : e (e.symm y) = y :=
e.to_equiv.apply_symm_apply y

/-- `e.symm` is a left inverse of `e`, written as `e.symm (e y) = y`. -/
@[simp, to_additive "`e.symm` is a left inverse of `e`, written as `e.symm (e y) = y`."]
lemma symm_apply_apply (e : M ≃* N) (x : M) : e.symm (e x) = x :=
e.to_equiv.symm_apply_apply x

@[simp, to_additive]
theorem symm_comp_self (e : M ≃* N) : e.symm ∘ e = id := funext e.symm_apply_apply

@[simp, to_additive]
theorem self_comp_symm (e : M ≃* N) : e ∘ e.symm = id := funext e.apply_symm_apply

@[simp, to_additive]
theorem coe_refl : ⇑(refl M) = id := rfl

@[to_additive]
theorem refl_apply (m : M) : refl M m = m := rfl

@[simp, to_additive]
theorem coe_trans (e₁ : M ≃* N) (e₂ : N ≃* P) : ⇑(e₁.trans e₂) = e₂ ∘ e₁ := rfl

@[to_additive]
theorem trans_apply (e₁ : M ≃* N) (e₂ : N ≃* P) (m : M) : e₁.trans e₂ m = e₂ (e₁ m) := rfl

@[simp, to_additive] theorem symm_trans_apply (e₁ : M ≃* N) (e₂ : N ≃* P) (p : P) :
  (e₁.trans e₂).symm p = e₁.symm (e₂.symm p) := rfl

@[simp, to_additive] theorem apply_eq_iff_eq (e : M ≃* N) {x y : M} : e x = e y ↔ x = y :=
e.injective.eq_iff

@[to_additive]
lemma apply_eq_iff_symm_apply (e : M ≃* N) {x : M} {y : N} : e x = y ↔ x = e.symm y :=
e.to_equiv.apply_eq_iff_eq_symm_apply

@[to_additive]
lemma symm_apply_eq (e : M ≃* N) {x y} : e.symm x = y ↔ x = e y :=
e.to_equiv.symm_apply_eq

@[to_additive]
lemma eq_symm_apply (e : M ≃* N) {x y} : y = e.symm x ↔ e y = x :=
e.to_equiv.eq_symm_apply

@[to_additive] lemma eq_comp_symm {α : Type*} (e : M ≃* N) (f : N → α) (g : M → α) :
  f = g ∘ e.symm ↔ f ∘ e = g := e.to_equiv.eq_comp_symm f g

@[to_additive] lemma comp_symm_eq {α : Type*} (e : M ≃* N) (f : N → α) (g : M → α) :
  g ∘ e.symm = f ↔ g = f ∘ e := e.to_equiv.comp_symm_eq f g

@[to_additive] lemma eq_symm_comp {α : Type*} (e : M ≃* N) (f : α → M) (g : α → N) :
  f = e.symm ∘ g ↔ e ∘ f = g := e.to_equiv.eq_symm_comp f g

@[to_additive] lemma symm_comp_eq {α : Type*} (e : M ≃* N) (f : α → M) (g : α → N) :
  e.symm ∘ g = f ↔ g = e ∘ f := e.to_equiv.symm_comp_eq f g

/-- Two multiplicative isomorphisms agree if they are defined by the
    same underlying function. -/
@[ext, to_additive
  "Two additive isomorphisms agree if they are defined by the same underlying function."]
lemma ext {f g : mul_equiv M N} (h : ∀ x, f x = g x) : f = g := fun_like.ext f g h

@[to_additive] lemma ext_iff {f g : mul_equiv M N} : f = g ↔ ∀ x, f x = g x := fun_like.ext_iff

@[simp, to_additive] lemma mk_coe (e : M ≃* N) (e' h₁ h₂ h₃) :
  (⟨e, e', h₁, h₂, h₃⟩ : M ≃* N) = e := ext $ λ _, rfl

@[simp, to_additive] lemma mk_coe' (e : M ≃* N) (f h₁ h₂ h₃) :
  (mul_equiv.mk f ⇑e h₁ h₂ h₃ : N ≃* M) = e.symm :=
symm_bijective.injective $ ext $ λ x, rfl

@[to_additive] protected lemma congr_arg {f : mul_equiv M N} {x x' : M} : x = x' → f x = f x' :=
fun_like.congr_arg f

@[to_additive] protected lemma congr_fun {f g : mul_equiv M N} (h : f = g) (x : M) : f x = g x :=
fun_like.congr_fun h x

/-- The `mul_equiv` between two monoids with a unique element. -/
@[to_additive "The `add_equiv` between two add_monoids with a unique element."]
def mul_equiv_of_unique_of_unique {M N}
  [unique M] [unique N] [has_mul M] [has_mul N] : M ≃* N :=
{ map_mul' := λ _ _, subsingleton.elim _ _,
  ..equiv_of_unique_of_unique }

/-- There is a unique monoid homomorphism between two monoids with a unique element. -/
@[to_additive
  "There is a unique additive monoid homomorphism between two additive monoids with
a unique element."]
instance {M N} [unique M] [unique N] [has_mul M] [has_mul N] : unique (M ≃* N) :=
{ default := mul_equiv_of_unique_of_unique ,
  uniq := λ _, ext $ λ x, subsingleton.elim _ _}

/-!
## Monoids
-/

/-- A multiplicative isomorphism of monoids sends `1` to `1` (and is hence a monoid isomorphism). -/
@[to_additive "An additive isomorphism of additive monoids sends `0` to `0`
(and is hence an additive monoid isomorphism)."]
protected lemma map_one {M N} [mul_one_class M] [mul_one_class N] (h : M ≃* N) : h 1 = 1 :=
map_one h

@[to_additive]
protected lemma map_eq_one_iff {M N} [mul_one_class M] [mul_one_class N] (h : M ≃* N) {x : M} :
  h x = 1 ↔ x = 1 :=
mul_equiv_class.map_eq_one_iff h

@[to_additive]
lemma map_ne_one_iff {M N} [mul_one_class M] [mul_one_class N] (h : M ≃* N) {x : M} :
  h x ≠ 1 ↔ x ≠ 1 :=
mul_equiv_class.map_ne_one_iff h

/-- A bijective `monoid` homomorphism is an isomorphism -/
@[to_additive "A bijective `add_monoid` homomorphism is an isomorphism"]
noncomputable def of_bijective {M N} [mul_one_class M] [mul_one_class N] (f : M →* N)
  (hf : function.bijective f) : M ≃* N :=
{ map_mul' := f.map_mul',
  ..equiv.of_bijective f hf }

/--
Extract the forward direction of a multiplicative equivalence
as a multiplication-preserving function.
-/
@[to_additive "Extract the forward direction of an additive equivalence
as an addition-preserving function."]
def to_monoid_hom {M N} [mul_one_class M] [mul_one_class N] (h : M ≃* N) : (M →* N) :=
{ map_one' := h.map_one, .. h }

@[simp, to_additive]
lemma coe_to_monoid_hom {M N} [mul_one_class M] [mul_one_class N] (e : M ≃* N) :
  ⇑e.to_monoid_hom = e :=
rfl

@[to_additive] lemma to_monoid_hom_injective {M N} [mul_one_class M] [mul_one_class N] :
  function.injective (to_monoid_hom : (M ≃* N) → M →* N) :=
λ f g h, mul_equiv.ext (monoid_hom.ext_iff.1 h)

/--
A multiplicative analogue of `equiv.arrow_congr`,
where the equivalence between the targets is multiplicative.
-/
@[to_additive "An additive analogue of `equiv.arrow_congr`,
where the equivalence between the targets is additive.", simps apply]
def arrow_congr {M N P Q : Type*} [mul_one_class P] [mul_one_class Q]
  (f : M ≃ N) (g : P ≃* Q) : (M → P) ≃* (N → Q) :=
{ to_fun := λ h n, g (h (f.symm n)),
  inv_fun := λ k m, g.symm (k (f m)),
  left_inv := λ h, by { ext, simp, },
  right_inv := λ k, by { ext, simp, },
  map_mul' := λ h k, by { ext, simp, }, }

/--
A multiplicative analogue of `equiv.arrow_congr`,
for multiplicative maps from a monoid to a commutative monoid.
-/
@[to_additive "An additive analogue of `equiv.arrow_congr`,
for additive maps from an additive monoid to a commutative additive monoid.", simps apply]
def monoid_hom_congr {M N P Q} [mul_one_class M] [mul_one_class N] [comm_monoid P] [comm_monoid Q]
  (f : M ≃* N) (g : P ≃* Q) : (M →* P) ≃* (N →* Q) :=
{ to_fun := λ h,
  g.to_monoid_hom.comp (h.comp f.symm.to_monoid_hom),
  inv_fun := λ k,
  g.symm.to_monoid_hom.comp (k.comp f.to_monoid_hom),
  left_inv := λ h, by { ext, simp, },
  right_inv := λ k, by { ext, simp, },
  map_mul' := λ h k, by { ext, simp, }, }

/-- A family of multiplicative equivalences `Π j, (Ms j ≃* Ns j)` generates a
multiplicative equivalence between `Π j, Ms j` and `Π j, Ns j`.

This is the `mul_equiv` version of `equiv.Pi_congr_right`, and the dependent version of
`mul_equiv.arrow_congr`.
-/
@[to_additive add_equiv.Pi_congr_right "A family of additive equivalences `Π j, (Ms j ≃+ Ns j)`
generates an additive equivalence between `Π j, Ms j` and `Π j, Ns j`.

This is the `add_equiv` version of `equiv.Pi_congr_right`, and the dependent version of
`add_equiv.arrow_congr`.", simps apply]
def Pi_congr_right {η : Type*}
  {Ms Ns : η → Type*} [Π j, mul_one_class (Ms j)] [Π j, mul_one_class (Ns j)]
  (es : ∀ j, Ms j ≃* Ns j) : (Π j, Ms j) ≃* (Π j, Ns j) :=
{ to_fun := λ x j, es j (x j),
  inv_fun := λ x j, (es j).symm (x j),
  map_mul' := λ x y, funext $ λ j, (es j).map_mul (x j) (y j),
  .. equiv.Pi_congr_right (λ j, (es j).to_equiv) }

@[simp]
lemma Pi_congr_right_refl {η : Type*} {Ms : η → Type*} [Π j, mul_one_class (Ms j)] :
  Pi_congr_right (λ j, mul_equiv.refl (Ms j)) = mul_equiv.refl _ := rfl

@[simp]
lemma Pi_congr_right_symm {η : Type*}
  {Ms Ns : η → Type*} [Π j, mul_one_class (Ms j)] [Π j, mul_one_class (Ns j)]
  (es : ∀ j, Ms j ≃* Ns j) : (Pi_congr_right es).symm = (Pi_congr_right $ λ i, (es i).symm) := rfl

@[simp]
lemma Pi_congr_right_trans {η : Type*}
  {Ms Ns Ps : η → Type*} [Π j, mul_one_class (Ms j)] [Π j, mul_one_class (Ns j)]
  [Π j, mul_one_class (Ps j)]
  (es : ∀ j, Ms j ≃* Ns j) (fs : ∀ j, Ns j ≃* Ps j) :
  (Pi_congr_right es).trans (Pi_congr_right fs) = (Pi_congr_right $ λ i, (es i).trans (fs i)) := rfl

/-- A family indexed by a nonempty subsingleton type is equivalent to the element at the single
index. -/
@[to_additive add_equiv.Pi_subsingleton "A family indexed by a nonempty subsingleton type is
equivalent to the element at the single index.", simps]
def Pi_subsingleton
  {ι : Type*} (M : ι → Type*) [Π j, has_mul (M j)] [subsingleton ι] (i : ι) :
  (Π j, M j) ≃* M i :=
{ map_mul' := λ f1 f2, pi.mul_apply _ _ _, ..equiv.Pi_subsingleton M i }

/-!
# Groups
-/

/-- A multiplicative equivalence of groups preserves inversion. -/
@[to_additive "An additive equivalence of additive groups preserves negation."]
protected lemma map_inv [group G] [group H] (h : G ≃* H) (x : G) : h x⁻¹ = (h x)⁻¹ :=
map_inv h x

/-- A multiplicative equivalence of groups preserves division. -/
@[to_additive "An additive equivalence of additive groups preserves subtractions."]
protected lemma map_div [group G] [group H] (h : G ≃* H) (x y : G) : h (x / y) = h x / h y :=
map_div h x y

end mul_equiv

/-- Given a pair of monoid homomorphisms `f`, `g` such that `g.comp f = id` and `f.comp g = id`,
returns an multiplicative equivalence with `to_fun = f` and `inv_fun = g`.  This constructor is
useful if the underlying type(s) have specialized `ext` lemmas for monoid homomorphisms. -/
@[to_additive /-"Given a pair of additive monoid homomorphisms `f`, `g` such that `g.comp f = id`
and `f.comp g = id`, returns an additive equivalence with `to_fun = f` and `inv_fun = g`.  This
constructor is useful if the underlying type(s) have specialized `ext` lemmas for additive
monoid homomorphisms."-/, simps {fully_applied := ff}]
def monoid_hom.to_mul_equiv [mul_one_class M] [mul_one_class N] (f : M →* N) (g : N →* M)
  (h₁ : g.comp f = monoid_hom.id _) (h₂ : f.comp g = monoid_hom.id _) :
  M ≃* N :=
{ to_fun := f,
  inv_fun := g,
  left_inv := monoid_hom.congr_fun h₁,
  right_inv := monoid_hom.congr_fun h₂,
  map_mul' := f.map_mul }

/-- A group is isomorphic to its group of units. -/
@[to_additive "An additive group is isomorphic to its group of additive units"]
def to_units [group G] : G ≃* Gˣ :=
{ to_fun := λ x, ⟨x, x⁻¹, mul_inv_self _, inv_mul_self _⟩,
  inv_fun := coe,
  left_inv := λ x, rfl,
  right_inv := λ u, units.ext rfl,
  map_mul' := λ x y, units.ext rfl }

@[simp, to_additive] lemma coe_to_units [group G] (g : G) :
  (to_units g : G) = g := rfl

@[to_additive]
protected lemma group.is_unit {G} [group G] (x : G) : is_unit x := (to_units x).is_unit

namespace units

@[simp, to_additive] lemma coe_inv [group G] (u : Gˣ) :
  ↑u⁻¹ = (u⁻¹ : G) :=
to_units.symm.map_inv u

variables [monoid M] [monoid N] [monoid P]

/-- A multiplicative equivalence of monoids defines a multiplicative equivalence
of their groups of units. -/
def map_equiv (h : M ≃* N) : Mˣ ≃* Nˣ :=
{ inv_fun := map h.symm.to_monoid_hom,
  left_inv := λ u, ext $ h.left_inv u,
  right_inv := λ u, ext $ h.right_inv u,
  .. map h.to_monoid_hom }

/-- Left multiplication by a unit of a monoid is a permutation of the underlying type. -/
@[to_additive "Left addition of an additive unit is a permutation of the underlying type.",
  simps apply {fully_applied := ff}]
def mul_left (u : Mˣ) : equiv.perm M :=
{ to_fun    := λx, u * x,
  inv_fun   := λx, ↑u⁻¹ * x,
  left_inv  := u.inv_mul_cancel_left,
  right_inv := u.mul_inv_cancel_left }

@[simp, to_additive]
lemma mul_left_symm (u : Mˣ) : u.mul_left.symm = u⁻¹.mul_left :=
equiv.ext $ λ x, rfl

@[to_additive]
lemma mul_left_bijective (a : Mˣ) : function.bijective ((*) a : M → M) :=
(mul_left a).bijective

/-- Right multiplication by a unit of a monoid is a permutation of the underlying type. -/
@[to_additive "Right addition of an additive unit is a permutation of the underlying type.",
  simps apply {fully_applied := ff}]
def mul_right (u : Mˣ) : equiv.perm M :=
{ to_fun    := λx, x * u,
  inv_fun   := λx, x * ↑u⁻¹,
  left_inv  := λ x, mul_inv_cancel_right x u,
  right_inv := λ x, inv_mul_cancel_right x u }

@[simp, to_additive]
lemma mul_right_symm (u : Mˣ) : u.mul_right.symm = u⁻¹.mul_right :=
equiv.ext $ λ x, rfl

@[to_additive]
lemma mul_right_bijective (a : Mˣ) : function.bijective ((* a) : M → M) :=
(mul_right a).bijective

end units

namespace equiv

section has_involutive_neg

variables (G) [has_involutive_inv G]

/-- Inversion on a `group` or `group_with_zero` is a permutation of the underlying type. -/
@[to_additive "Negation on an `add_group` is a permutation of the underlying type.",
  simps apply {fully_applied := ff}]
protected def inv : perm G := inv_involutive.to_perm _

variable {G}

@[simp, to_additive]
lemma inv_symm : (equiv.inv G).symm = equiv.inv G := rfl

end has_involutive_neg

section group
variables [group G]

/-- Left multiplication in a `group` is a permutation of the underlying type. -/
@[to_additive "Left addition in an `add_group` is a permutation of the underlying type."]
protected def mul_left (a : G) : perm G := (to_units a).mul_left

@[simp, to_additive]
lemma coe_mul_left (a : G) : ⇑(equiv.mul_left a) = (*) a := rfl

/-- Extra simp lemma that `dsimp` can use. `simp` will never use this. -/
@[simp, nolint simp_nf,
  to_additive "Extra simp lemma that `dsimp` can use. `simp` will never use this."]
lemma mul_left_symm_apply (a : G) : ((equiv.mul_left a).symm : G → G) = (*) a⁻¹ := rfl

@[simp, to_additive]
lemma mul_left_symm (a : G) : (equiv.mul_left a).symm = equiv.mul_left a⁻¹ :=
ext $ λ x, rfl

@[to_additive]
lemma _root_.group.mul_left_bijective (a : G) : function.bijective ((*) a) :=
(equiv.mul_left a).bijective

/-- Right multiplication in a `group` is a permutation of the underlying type. -/
@[to_additive "Right addition in an `add_group` is a permutation of the underlying type."]
protected def mul_right (a : G) : perm G := (to_units a).mul_right

@[simp, to_additive]
lemma coe_mul_right (a : G) : ⇑(equiv.mul_right a) = λ x, x * a := rfl

@[simp, to_additive]
lemma mul_right_symm (a : G) : (equiv.mul_right a).symm = equiv.mul_right a⁻¹ :=
ext $ λ x, rfl

/-- Extra simp lemma that `dsimp` can use. `simp` will never use this. -/
@[simp, nolint simp_nf,
  to_additive "Extra simp lemma that `dsimp` can use. `simp` will never use this."]
lemma mul_right_symm_apply (a : G) : ((equiv.mul_right a).symm : G → G) = λ x, x * a⁻¹ := rfl

@[to_additive]
lemma _root_.group.mul_right_bijective (a : G) : function.bijective (* a) :=
(equiv.mul_right a).bijective

/-- A version of `equiv.mul_left a b⁻¹` that is defeq to `a / b`. -/
@[to_additive /-" A version of `equiv.add_left a (-b)` that is defeq to `a - b`. "-/, simps]
protected def div_left (a : G) : G ≃ G :=
{ to_fun := λ b, a / b,
  inv_fun := λ b, b⁻¹ * a,
  left_inv := λ b, by simp [div_eq_mul_inv],
  right_inv := λ b, by simp [div_eq_mul_inv] }

@[to_additive]
lemma div_left_eq_inv_trans_mul_left (a : G) :
  equiv.div_left a = (equiv.inv G).trans (equiv.mul_left a) :=
ext $ λ _, div_eq_mul_inv _ _

/-- A version of `equiv.mul_right a⁻¹ b` that is defeq to `b / a`. -/
@[to_additive /-" A version of `equiv.add_right (-a) b` that is defeq to `b - a`. "-/, simps]
protected def div_right (a : G) : G ≃ G :=
{ to_fun := λ b, b / a,
  inv_fun := λ b, b * a,
  left_inv := λ b, by simp [div_eq_mul_inv],
  right_inv := λ b, by simp [div_eq_mul_inv] }

@[to_additive]
lemma div_right_eq_mul_right_inv (a : G) : equiv.div_right a = equiv.mul_right a⁻¹ :=
ext $ λ _, div_eq_mul_inv _ _

end group

section group_with_zero
variables [group_with_zero G]

/-- Left multiplication by a nonzero element in a `group_with_zero` is a permutation of the
underlying type. -/
@[simps {fully_applied := ff}]
protected def mul_left₀ (a : G) (ha : a ≠ 0) : perm G :=
(units.mk0 a ha).mul_left

lemma _root_.mul_left_bijective₀ (a : G) (ha : a ≠ 0) :
  function.bijective ((*) a : G → G) :=
(equiv.mul_left₀ a ha).bijective

/-- Right multiplication by a nonzero element in a `group_with_zero` is a permutation of the
underlying type. -/
@[simps {fully_applied := ff}]
protected def mul_right₀ (a : G) (ha : a ≠ 0) : perm G :=
(units.mk0 a ha).mul_right

lemma _root_.mul_right_bijective₀ (a : G) (ha : a ≠ 0) :
  function.bijective ((* a) : G → G) :=
(equiv.mul_right₀ a ha).bijective

end group_with_zero

end equiv

/-- When the group is commutative, `equiv.inv` is a `mul_equiv`. There is a variant of this
`mul_equiv.inv' G : G ≃* Gᵐᵒᵖ` for the non-commutative case. -/
@[to_additive "When the `add_group` is commutative, `equiv.neg` is an `add_equiv`."]
def mul_equiv.inv (G : Type*) [comm_group G] : G ≃* G :=
{ to_fun   := has_inv.inv,
  inv_fun  := has_inv.inv,
  map_mul' := mul_inv,
  ..equiv.inv G }

/-- When the group with zero is commutative, `equiv.inv₀` is a `mul_equiv`. -/
@[simps apply] def mul_equiv.inv₀ (G : Type*) [comm_group_with_zero G] : G ≃* G :=
{ to_fun   := has_inv.inv,
  inv_fun  := has_inv.inv,
  map_mul' := λ x y, mul_inv₀,
  ..equiv.inv G }

@[simp] lemma mul_equiv.inv₀_symm (G : Type*) [comm_group_with_zero G] :
  (mul_equiv.inv₀ G).symm = mul_equiv.inv₀ G := rfl

section type_tags

/-- Reinterpret `G ≃+ H` as `multiplicative G ≃* multiplicative H`. -/
def add_equiv.to_multiplicative [add_zero_class G] [add_zero_class H] :
  (G ≃+ H) ≃ (multiplicative G ≃* multiplicative H) :=
{ to_fun := λ f, ⟨f.to_add_monoid_hom.to_multiplicative,
                  f.symm.to_add_monoid_hom.to_multiplicative, f.3, f.4, f.5⟩,
  inv_fun := λ f, ⟨f.to_monoid_hom, f.symm.to_monoid_hom, f.3, f.4, f.5⟩,
  left_inv := λ x, by { ext, refl, },
  right_inv := λ x, by { ext, refl, }, }

/-- Reinterpret `G ≃* H` as `additive G ≃+ additive H`. -/
def mul_equiv.to_additive [mul_one_class G] [mul_one_class H] :
  (G ≃* H) ≃ (additive G ≃+ additive H) :=
{ to_fun := λ f, ⟨f.to_monoid_hom.to_additive, f.symm.to_monoid_hom.to_additive, f.3, f.4, f.5⟩,
  inv_fun := λ f, ⟨f.to_add_monoid_hom, f.symm.to_add_monoid_hom, f.3, f.4, f.5⟩,
  left_inv := λ x, by { ext, refl, },
  right_inv := λ x, by { ext, refl, }, }

/-- Reinterpret `additive G ≃+ H` as `G ≃* multiplicative H`. -/
def add_equiv.to_multiplicative' [mul_one_class G] [add_zero_class H] :
  (additive G ≃+ H) ≃ (G ≃* multiplicative H) :=
{ to_fun := λ f, ⟨f.to_add_monoid_hom.to_multiplicative',
                  f.symm.to_add_monoid_hom.to_multiplicative'', f.3, f.4, f.5⟩,
  inv_fun := λ f, ⟨f.to_monoid_hom, f.symm.to_monoid_hom, f.3, f.4, f.5⟩,
  left_inv := λ x, by { ext, refl, },
  right_inv := λ x, by { ext, refl, }, }

/-- Reinterpret `G ≃* multiplicative H` as `additive G ≃+ H` as. -/
def mul_equiv.to_additive' [mul_one_class G] [add_zero_class H] :
  (G ≃* multiplicative H) ≃ (additive G ≃+ H) :=
add_equiv.to_multiplicative'.symm

/-- Reinterpret `G ≃+ additive H` as `multiplicative G ≃* H`. -/
def add_equiv.to_multiplicative'' [add_zero_class G] [mul_one_class H] :
  (G ≃+ additive H) ≃ (multiplicative G ≃* H) :=
{ to_fun := λ f, ⟨f.to_add_monoid_hom.to_multiplicative'',
                  f.symm.to_add_monoid_hom.to_multiplicative', f.3, f.4, f.5⟩,
  inv_fun := λ f, ⟨f.to_monoid_hom, f.symm.to_monoid_hom, f.3, f.4, f.5⟩,
  left_inv := λ x, by { ext, refl, },
  right_inv := λ x, by { ext, refl, }, }

/-- Reinterpret `multiplicative G ≃* H` as `G ≃+ additive H` as. -/
def mul_equiv.to_additive'' [add_zero_class G] [mul_one_class H] :
  (multiplicative G ≃* H) ≃ (G ≃+ additive H) :=
add_equiv.to_multiplicative''.symm

end type_tags


import mynat.definition -- imports the natural numbers {0,1,2,3,4,...}.
import mynat.add -- imports definition of addition on the natural numbers.
import mynat.mul -- imports definition of multiplication on the natural numbers.
namespace mynat -- hide

/-
# Tutorial World

## Level 1: the `refl` tactic.

Let's learn some tactics! Let's start with the `refl` tactic. `refl` stands for "reflexivity", which is a fancy
way of saying that it will prove any goal of the form `A = A`. It doesn't matter how
complicated `A` is, all that matters is that the left hand side is *exactly equal* to the
right hand side (a computer scientist would say "definitionally equal"). I really mean
"press the same buttons on your computer in the same order" equal.
For example, `x * y + z = x * y + z` can be proved by `refl`, but `x + y = y + x` cannot.

Each level in this game involves proving a theorem or a lemma (a lemma is just a baby theorem).
The goal of the theorem will be a mathematical statement with a `⊢` just before it.
We will use tactics to manipulate and ultimately close (i.e. prove) these goals.

Let's see `refl` in action! At the bottom of the text in this box, there's a lemma,
which says that if $x$, $y$ and $z$ are natural numbers then $xy + z = xy + z$.
Locate this lemma (if you can't see the lemma and these instructions at the same time, make this box wider
by dragging the sides). Let's supply the proof. Click on the word `sorry` and then delete it.
When the system finishes being busy, you'll be able to see your goal -- the objective
of this level -- in the box on the top right. [NB if your system never finishes being busy, then
your computer is not running the javascript Lean which powers everything behind the scenes.
Try Chrome? Try not using private browsing?]

Remember that the goal is
the thing with the weird `⊢` thing just before it. The goal in this case is `x * y + z = x * y + z`,
where `x`, `y` and `z` are some of your very own natural numbers.
That's a pretty easy goal to prove -- you can just prove it with the `refl` tactic.
Where it used to say `sorry`, write

`refl,`

**and don't forget the comma**. Then hit enter to go onto the next line.
If all is well, Lean should tell you "Proof complete!" in the top right box, and there
should be no errors in the bottom right box. You just did the first
level of the tutorial! And you also learnt how to avoid by *far* the most
common mistake that beginner users make -- **every line must end with a comma**.
If things go weird and you don't understand why the top right box is empty,
check for missing commas. Also check you've spelt `refl` correctly: it's REFL
for "reflexivity".

For each level, the idea is to get Lean into this state: with the top right
box saying "Proof complete!" and the bottom right box empty (i.e. with no errors in).

If you want to be reminded about the `refl` tactic, you can click on the "Tactics" drop
down menu on the left. Resize the window if it's too small.

Now click on "next level" in the top right of your browser to go onto the second level of
tutorial world, where we'll learn about the `rw` tactic.
-/

/- Lemma : no-side-bar
For all natural numbers $x$, $y$ and $z$, we have $xy + z = xy + z$.
-/
lemma example1 (x y z : mynat) : x * y + z = x * y + z :=
begin [nat_num_game]
  refl

end

/- Tactic : refl

## Summary

`refl` proves goals of the form `X = X`.

## Details

The `refl` tactic will close any goal of the form `A = B`
where `A` and `B` are *exactly the same thing*.

### Example:
If it looks like this in the top right hand box:
```
a b c d : mynat
⊢ (a + b) * (c + d) = (a + b) * (c + d)
```

then

`refl,`

will close the goal and solve the level. Don't forget the comma.

-/

end mynat -- hide


/-
Copyright (c) 2021 Aaron Anderson, Jesse Michael Han, Floris van Doorn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Aaron Anderson, Jesse Michael Han, Floris van Doorn
-/
import data.fin.vec_notation
import data.fin.tuple.basic
import logic.encodable.basic
import logic.small
import set_theory.cardinal
import category_theory.concrete_category.bundled

/-!
# Basics on First-Order Structures
This file defines first-order languages and structures in the style of the
[Flypitch project](https://flypitch.github.io/), as well as several important maps between
structures.

## Main Definitions
* A `first_order.language` defines a language as a pair of functions from the natural numbers to
  `Type l`. One sends `n` to the type of `n`-ary functions, and the other sends `n` to the type of
  `n`-ary relations.
* A `first_order.language.Structure` interprets the symbols of a given `first_order.language` in the
  context of a given type.
* A `first_order.language.hom`, denoted `M →[L] N`, is a map from the `L`-structure `M` to the
  `L`-structure `N` that commutes with the interpretations of functions, and which preserves the
  interpretations of relations (although only in the forward direction).
* A `first_order.language.embedding`, denoted `M ↪[L] N`, is an embedding from the `L`-structure `M`
  to the `L`-structure `N` that commutes with the interpretations of functions, and which preserves
  the interpretations of relations in both directions.
* A `first_order.language.elementary_embedding`, denoted `M ↪ₑ[L] N`, is an embedding from the
  `L`-structure `M` to the `L`-structure `N` that commutes with the realizations of all formulas.
* A `first_order.language.equiv`, denoted `M ≃[L] N`, is an equivalence from the `L`-structure `M`
  to the `L`-structure `N` that commutes with the interpretations of functions, and which preserves
  the interpretations of relations in both directions.

## References
For the Flypitch project:
- [J. Han, F. van Doorn, *A formal proof of the independence of the continuum hypothesis*]
[flypitch_cpp]
- [J. Han, F. van Doorn, *A formalization of forcing and the unprovability of
the continuum hypothesis*][flypitch_itp]

-/
universes u v u' v' w

open_locale cardinal
open cardinal

namespace first_order

/-! ### Languages and Structures -/

/-- A first-order language consists of a type of functions of every natural-number arity and a
  type of relations of every natural-number arity. -/
@[nolint check_univs] -- intended to be used with explicit universe parameters
structure language :=
(functions : ℕ → Type u) (relations : ℕ → Type v)

/-- Used to define `first_order.language₂`. -/
def sequence₂ (a₀ a₁ a₂ : Type u) : ℕ → Type u
| 0 := a₀
| 1 := a₁
| 2 := a₂
| _ := pempty

instance {a₀ a₁ a₂ : Type u} [h : inhabited a₀] : inhabited (sequence₂ a₀ a₁ a₂ 0) := h

namespace language

/-- A constructor for languages with only constants, unary and binary functions, and
unary and binary relations. -/
protected def mk₂ (c f₁ f₂ : Type u) (r₁ r₂ : Type v) : language :=
⟨sequence₂ c f₁ f₂, sequence₂ pempty r₁ r₂⟩

/-- The empty language has no symbols. -/
protected def empty : language := ⟨λ _, pempty, λ _, pempty⟩

instance : inhabited language := ⟨language.empty⟩

/-- The sum of two languages consists of the disjoint union of their symbols. -/
protected def sum (L : language.{u v}) (L' : language.{u' v'}) : language :=
⟨λn, L.functions n ⊕ L'.functions n, λ n, L.relations n ⊕ L'.relations n⟩

variable (L : language.{u v})

/-- The type of constants in a given language. -/
@[nolint has_inhabited_instance] protected def «constants» := L.functions 0

/-- The type of symbols in a given language. -/
@[nolint has_inhabited_instance] def symbols := (Σl, L.functions l) ⊕ (Σl, L.relations l)

/-- The cardinality of a language is the cardinality of its type of symbols. -/
def card : cardinal := # L.symbols

/-- A language is countable when it has countably many symbols. -/
class countable : Prop := (card_le_omega' : L.card ≤ ω)

lemma card_le_omega [L.countable] : L.card ≤ ω := countable.card_le_omega'

/-- A language is relational when it has no function symbols. -/
class is_relational : Prop :=
(empty_functions : ∀ n, is_empty (L.functions n))

/-- A language is algebraic when it has no relation symbols. -/
class is_algebraic : Prop :=
(empty_relations : ∀ n, is_empty (L.relations n))

/-- A language is countable when it has countably many symbols. -/
class countable_functions : Prop := (card_functions_le_omega' : # (Σl, L.functions l) ≤ ω)

lemma card_functions_le_omega [L.countable_functions] :
  # (Σl, L.functions l) ≤ ω :=
countable_functions.card_functions_le_omega'

variables {L} {L' : language.{u' v'}}

lemma card_eq_card_functions_add_card_relations :
  L.card = cardinal.lift.{v} (# (Σl, L.functions l)) +
    cardinal.lift.{u} (# (Σl, L.relations l)) :=
by rw [card, symbols, mk_sum]

instance [L.is_relational] {n : ℕ} : is_empty (L.functions n) := is_relational.empty_functions n

instance [L.is_algebraic] {n : ℕ} : is_empty (L.relations n) := is_algebraic.empty_relations n

instance is_relational_of_empty_functions {symb : ℕ → Type*} : is_relational ⟨λ _, pempty, symb⟩ :=
⟨λ _, pempty.is_empty⟩

instance is_algebraic_of_empty_relations {symb : ℕ → Type*}  : is_algebraic ⟨symb, λ _, pempty⟩ :=
⟨λ _, pempty.is_empty⟩

instance is_relational_empty : is_relational language.empty :=
language.is_relational_of_empty_functions

instance is_algebraic_empty : is_algebraic language.empty :=
language.is_algebraic_of_empty_relations

instance is_relational_sum [L.is_relational] [L'.is_relational] : is_relational (L.sum L') :=
⟨λ n, sum.is_empty⟩

instance is_algebraic_sum [L.is_algebraic] [L'.is_algebraic] : is_algebraic (L.sum L') :=
⟨λ n, sum.is_empty⟩

instance is_relational_mk₂ {c f₁ f₂ : Type u} {r₁ r₂ : Type v}
  [h0 : is_empty c] [h1 : is_empty f₁] [h2 : is_empty f₂] :
  is_relational (language.mk₂ c f₁ f₂ r₁ r₂) :=
⟨λ n, nat.cases_on n h0 (λ n, nat.cases_on n h1 (λ n, nat.cases_on n h2 (λ _, pempty.is_empty)))⟩

instance is_algebraic_mk₂ {c f₁ f₂ : Type u} {r₁ r₂ : Type v}
  [h1 : is_empty r₁] [h2 : is_empty r₂] :
  is_algebraic (language.mk₂ c f₁ f₂ r₁ r₂) :=
⟨λ n, nat.cases_on n pempty.is_empty
  (λ n, nat.cases_on n h1 (λ n, nat.cases_on n h2 (λ _, pempty.is_empty)))⟩

instance subsingleton_mk₂_functions {c f₁ f₂ : Type u} {r₁ r₂ : Type v}
  [h0 : subsingleton c] [h1 : subsingleton f₁] [h2 : subsingleton f₂] {n : ℕ} :
  subsingleton ((language.mk₂ c f₁ f₂ r₁ r₂).functions n) :=
nat.cases_on n h0 (λ n, nat.cases_on n h1 (λ n, nat.cases_on n h2 (λ n, ⟨λ x, pempty.elim x⟩)))

instance subsingleton_mk₂_relations {c f₁ f₂ : Type u} {r₁ r₂ : Type v}
  [h1 : subsingleton r₁] [h2 : subsingleton r₂] {n : ℕ} :
  subsingleton ((language.mk₂ c f₁ f₂ r₁ r₂).relations n) :=
nat.cases_on n ⟨λ x, pempty.elim x⟩
  (λ n, nat.cases_on n h1 (λ n, nat.cases_on n h2 (λ n, ⟨λ x, pempty.elim x⟩)))

lemma encodable.countable [h : encodable L.symbols] :
  L.countable :=
⟨cardinal.encodable_iff.1 ⟨h⟩⟩

instance countable_empty : language.empty.countable :=
⟨begin
  rw [card_eq_card_functions_add_card_relations, add_le_omega, lift_le_omega, lift_le_omega,
    ← cardinal.encodable_iff, ← cardinal.encodable_iff],
  exact ⟨⟨encodable.sigma⟩, ⟨encodable.sigma⟩⟩,
end⟩

@[priority 100] instance countable.countable_functions [L.countable] :
  L.countable_functions :=
⟨begin
  refine lift_le_omega.1 (trans _ L.card_le_omega),
  rw [card, symbols, mk_sum],
  exact le_self_add,
end⟩

lemma encodable.countable_functions [h : encodable (Σl, L.functions l)] :
  L.countable_functions :=
⟨cardinal.encodable_iff.1 ⟨h⟩⟩

@[priority 100] instance is_relational.countable_functions [L.is_relational] :
  L.countable_functions :=
encodable.countable_functions

variables (L) (M : Type w)

/-- A first-order structure on a type `M` consists of interpretations of all the symbols in a given
  language. Each function of arity `n` is interpreted as a function sending tuples of length `n`
  (modeled as `(fin n → M)`) to `M`, and a relation of arity `n` is a function from tuples of length
  `n` to `Prop`. -/
class Structure :=
(fun_map : ∀{n}, L.functions n → (fin n → M) → M)
(rel_map : ∀{n}, L.relations n → (fin n → M) → Prop)

variables (N : Type*) [L.Structure M] [L.Structure N]

open Structure

/-- Used for defining `first_order.language.Theory.Model.inhabited`. -/
def trivial_unit_structure : L.Structure unit := ⟨default, default⟩

/-! ### Maps -/

/-- A homomorphism between first-order structures is a function that commutes with the
  interpretations of functions and maps tuples in one structure where a given relation is true to
  tuples in the second structure where that relation is still true. -/
structure hom :=
(to_fun : M → N)
(map_fun' : ∀{n} (f : L.functions n) x, to_fun (fun_map f x) = fun_map f (to_fun ∘ x) . obviously)
(map_rel' : ∀{n} (r : L.relations n) x, rel_map r x → rel_map r (to_fun ∘ x) . obviously)

localized "notation A ` →[`:25 L `] ` B := first_order.language.hom L A B" in first_order

/-- An embedding of first-order structures is an embedding that commutes with the
  interpretations of functions and relations. -/
@[ancestor function.embedding] structure embedding extends M ↪ N :=
(map_fun' : ∀{n} (f : L.functions n) x, to_fun (fun_map f x) = fun_map f (to_fun ∘ x) . obviously)
(map_rel' : ∀{n} (r : L.relations n) x, rel_map r (to_fun ∘ x) ↔ rel_map r x . obviously)

localized "notation A ` ↪[`:25 L `] ` B := first_order.language.embedding L A B" in first_order

/-- An equivalence of first-order structures is an equivalence that commutes with the
  interpretations of functions and relations. -/
structure equiv extends M ≃ N :=
(map_fun' : ∀{n} (f : L.functions n) x, to_fun (fun_map f x) = fun_map f (to_fun ∘ x) . obviously)
(map_rel' : ∀{n} (r : L.relations n) x, rel_map r (to_fun ∘ x) ↔ rel_map r x . obviously)

localized "notation A ` ≃[`:25 L `] ` B := first_order.language.equiv L A B" in first_order

variables {L M N} {P : Type*} [L.Structure P] {Q : Type*} [L.Structure Q]

instance : has_coe_t L.constants M :=
⟨λ c, fun_map c default⟩

lemma fun_map_eq_coe_constants {c : L.constants} {x : fin 0 → M} :
  fun_map c x = c := congr rfl (funext fin.elim0)

/-- Given a language with a nonempty type of constants, any structure will be nonempty. This cannot
  be a global instance, because `L` becomes a metavariable. -/
lemma nonempty_of_nonempty_constants [h : nonempty L.constants] : nonempty M :=
h.map coe

/-- The function map for `first_order.language.Structure₂`. -/
def fun_map₂ {c f₁ f₂ : Type u} {r₁ r₂ : Type v}
  (c' : c → M) (f₁' : f₁ → M → M) (f₂' : f₂ → M → M → M) :
  ∀{n}, (language.mk₂ c f₁ f₂ r₁ r₂).functions n → (fin n → M) → M
| 0 f _ := c' f
| 1 f x := f₁' f (x 0)
| 2 f x := f₂' f (x 0) (x 1)
| (n + 3) f _ := pempty.elim f

/-- The relation map for `first_order.language.Structure₂`. -/
def rel_map₂ {c f₁ f₂ : Type u} {r₁ r₂ : Type v}
  (r₁' : r₁ → set M) (r₂' : r₂ → M → M → Prop) :
  ∀{n}, (language.mk₂ c f₁ f₂ r₁ r₂).relations n → (fin n → M) → Prop
| 0 r _ := pempty.elim r
| 1 r x := (x 0) ∈ r₁' r
| 2 r x := r₂' r (x 0) (x 1)
| (n + 3) r _ := pempty.elim r

/-- A structure constructor to match `first_order.language₂`. -/
protected def Structure.mk₂ {c f₁ f₂ : Type u} {r₁ r₂ : Type v}
  (c' : c → M) (f₁' : f₁ → M → M) (f₂' : f₂ → M → M → M)
  (r₁' : r₁ → set M) (r₂' : r₂ → M → M → Prop) :
  (language.mk₂ c f₁ f₂ r₁ r₂).Structure M :=
⟨λ _, fun_map₂ c' f₁' f₂', λ _, rel_map₂ r₁' r₂'⟩

namespace Structure

variables {c f₁ f₂ : Type u} {r₁ r₂ : Type v}
variables {c' : c → M} {f₁' : f₁ → M → M} {f₂' : f₂ → M → M → M}
variables {r₁' : r₁ → set M} {r₂' : r₂ → M → M → Prop}

@[simp] lemma fun_map_apply₀ (c₀ : c) {x : fin 0 → M} :
  @Structure.fun_map _ M (Structure.mk₂ c' f₁' f₂' r₁' r₂') 0 c₀ x = c' c₀ := rfl

@[simp] lemma fun_map_apply₁ (f : f₁) (x : M) :
  @Structure.fun_map _ M (Structure.mk₂ c' f₁' f₂' r₁' r₂') 1 f (![x]) = f₁' f x := rfl

@[simp] lemma fun_map_apply₂ (f : f₂) (x y : M) :
  @Structure.fun_map _ M (Structure.mk₂ c' f₁' f₂' r₁' r₂') 2 f (![x,y]) = f₂' f x y := rfl

@[simp] lemma rel_map_apply₁ (r : r₁) (x : M) :
  @Structure.rel_map _ M (Structure.mk₂ c' f₁' f₂' r₁' r₂') 1 r (![x]) = (x ∈ r₁' r) := rfl

@[simp]

end Structure

/-- `hom_class L F M N` states that `F` is a type of `L`-homomorphisms. You should extend this
  typeclass when you extend `first_order.language.hom`. -/
class hom_class (L : out_param language) (F : Type*)
  (M N : out_param $ Type*) [fun_like F M (λ _, N)] [L.Structure M] [L.Structure N] :=
(map_fun : ∀ (φ : F) {n} (f : L.functions n) x, φ (fun_map f x) = fun_map f (φ ∘ x))
(map_rel : ∀ (φ : F) {n} (r : L.relations n) x, rel_map r x → rel_map r (φ ∘ x))

/-- `strong_hom_class L F M N` states that `F` is a type of `L`-homomorphisms which preserve
  relations in both directions. -/
class strong_hom_class (L : out_param language) (F : Type*) (M N : out_param $ Type*)
  [fun_like F M (λ _, N)] [L.Structure M] [L.Structure N] :=
(map_fun : ∀ (φ : F) {n} (f : L.functions n) x, φ (fun_map f x) = fun_map f (φ ∘ x))
(map_rel : ∀ (φ : F) {n} (r : L.relations n) x, rel_map r (φ ∘ x) ↔ rel_map r x)

@[priority 100] instance strong_hom_class.hom_class
  {F M N} [L.Structure M] [L.Structure N] [fun_like F M (λ _, N)] [strong_hom_class L F M N] :
  hom_class L F M N :=
{ map_fun := strong_hom_class.map_fun,
  map_rel := λ φ n R x, (strong_hom_class.map_rel φ R x).2 }

/-- Not an instance to avoid a loop. -/
def hom_class.strong_hom_class_of_is_algebraic [L.is_algebraic]
  {F M N} [L.Structure M] [L.Structure N] [fun_like F M (λ _, N)] [hom_class L F M N] :
  strong_hom_class L F M N :=
{ map_fun := hom_class.map_fun,
  map_rel := λ φ n R x, (is_algebraic.empty_relations n).elim R }

lemma hom_class.map_constants {F M N} [L.Structure M] [L.Structure N] [fun_like F M (λ _, N)]
  [hom_class L F M N]
  (φ : F) (c : L.constants) : φ (c) = c :=
(hom_class.map_fun φ c default).trans (congr rfl (funext default))

namespace hom

instance fun_like : fun_like (M →[L] N) M (λ _, N) :=
{ coe := hom.to_fun,
  coe_injective' := λ f g h, by {cases f, cases g, cases h, refl} }

instance hom_class : hom_class L (M →[L] N) M N :=
{ map_fun := map_fun',
  map_rel := map_rel' }

instance [L.is_algebraic] : strong_hom_class L (M →[L] N) M N :=
hom_class.strong_hom_class_of_is_algebraic

instance has_coe_to_fun : has_coe_to_fun (M →[L] N) (λ _, M → N) := fun_like.has_coe_to_fun

@[simp] lemma to_fun_eq_coe {f : M →[L] N} : f.to_fun = (f : M → N) := rfl

@[ext]
lemma ext ⦃f g : M →[L] N⦄ (h : ∀ x, f x = g x) : f = g :=
fun_like.ext f g h

lemma ext_iff {f g : M →[L] N} : f = g ↔ ∀ x, f x = g x :=
fun_like.ext_iff

@[simp] lemma map_fun (φ : M →[L] N) {n : ℕ} (f : L.functions n) (x : fin n → M) :
  φ (fun_map f x) = fun_map f (φ ∘ x) :=
hom_class.map_fun φ f x

@[simp] lemma map_constants (φ : M →[L] N) (c : L.constants) : φ c = c :=
hom_class.map_constants φ c

@[simp] lemma map_rel (φ : M →[L] N) {n : ℕ} (r : L.relations n) (x : fin n → M) :
  rel_map r x → rel_map r (φ ∘ x) :=
hom_class.map_rel φ r x

variables (L) (M)
/-- The identity map from a structure to itself -/
@[refl] def id : M →[L] M :=
{ to_fun := id }

variables {L} {M}

instance : inhabited (M →[L] M) := ⟨id L M⟩

@[simp] lemma id_apply (x : M) :
  id L M x = x := rfl

/-- Composition of first-order homomorphisms -/
@[trans] def comp (hnp : N →[L] P) (hmn : M →[L] N) : M →[L] P :=
{ to_fun := hnp ∘ hmn,
  map_rel' := λ _ _ _ h, by simp [h] }

@[simp] lemma comp_apply (g : N →[L] P) (f : M →[L] N) (x : M) :
  g.comp f x = g (f x) := rfl

/-- Composition of first-order homomorphisms is associative. -/
lemma comp_assoc (f : M →[L] N) (g : N →[L] P) (h : P →[L] Q) :
  (h.comp g).comp f = h.comp (g.comp f) := rfl

end hom

namespace embedding

instance embedding_like : embedding_like (M ↪[L] N) M N :=
{ coe := λ f, f.to_fun,
  injective' := λ f, f.to_embedding.injective,
  coe_injective' := λ f g h, begin
    cases f,
    cases g,
    simp only,
    ext x,
    exact function.funext_iff.1 h x end }

instance strong_hom_class : strong_hom_class L (M ↪[L] N) M N :=
{ map_fun := map_fun',
  map_rel := map_rel' }

instance has_coe_to_fun : has_coe_to_fun (M ↪[L] N) (λ _, M → N) :=
fun_like.has_coe_to_fun

@[simp] lemma map_fun (φ : M ↪[L] N) {n : ℕ} (f : L.functions n) (x : fin n → M) :
  φ (fun_map f x) = fun_map f (φ ∘ x) :=
hom_class.map_fun φ f x

@[simp] lemma map_constants (φ : M ↪[L] N) (c : L.constants) : φ c = c :=
hom_class.map_constants φ c

@[simp] lemma map_rel (φ : M ↪[L] N) {n : ℕ} (r : L.relations n) (x : fin n → M) :
  rel_map r (φ ∘ x) ↔ rel_map r x :=
strong_hom_class.map_rel φ r x

/-- A first-order embedding is also a first-order homomorphism. -/
def to_hom (f : M ↪[L] N) : M →[L] N :=
{ to_fun := f }

@[simp]
lemma coe_to_hom {f : M ↪[L] N} : (f.to_hom : M → N) = f := rfl

lemma coe_injective : @function.injective (M ↪[L] N) (M → N) coe_fn
| f g h :=
begin
  cases f,
  cases g,
  simp only,
  ext x,
  exact function.funext_iff.1 h x,
end

@[ext]
lemma ext ⦃f g : M ↪[L] N⦄ (h : ∀ x, f x = g x) : f = g :=
coe_injective (funext h)

lemma ext_iff {f g : M ↪[L] N} : f = g ↔ ∀ x, f x = g x :=
⟨λ h x, h ▸ rfl, λ h, ext h⟩

lemma injective (f : M ↪[L] N) : function.injective f := f.to_embedding.injective

/-- In an algebraic language, any injective homomorphism is an embedding. -/
@[simps] def of_injective [L.is_algebraic] {f : M →[L] N} (hf : function.injective f) : M ↪[L] N :=
{ inj' := hf,
  map_rel' := λ n r x, strong_hom_class.map_rel f r x,
  .. f }

@[simp] lemma coe_fn_of_injective [L.is_algebraic] {f : M →[L] N} (hf : function.injective f) :
  (of_injective hf : M → N) = f := rfl

@[simp] lemma of_injective_to_hom [L.is_algebraic] {f : M →[L] N} (hf : function.injective f) :
  (of_injective hf).to_hom = f :=
by { ext, simp }

variables (L) (M)
/-- The identity embedding from a structure to itself -/
@[refl] def refl : M ↪[L] M :=
{ to_embedding := function.embedding.refl M }

variables {L} {M}

instance : inhabited (M ↪[L] M) := ⟨refl L M⟩

@[simp] lemma refl_apply (x : M) :
  refl L M x = x := rfl

/-- Composition of first-order embeddings -/
@[trans] def comp (hnp : N ↪[L] P) (hmn : M ↪[L] N) : M ↪[L] P :=
{ to_fun := hnp ∘ hmn,
  inj' := hnp.injective.comp hmn.injective }

@[simp] lemma comp_apply (g : N ↪[L] P) (f : M ↪[L] N) (x : M) :
  g.comp f x = g (f x) := rfl

/-- Composition of first-order embeddings is associative. -/
lemma comp_assoc (f : M ↪[L] N) (g : N ↪[L] P) (h : P ↪[L] Q) :
  (h.comp g).comp f = h.comp (g.comp f) := rfl

@[simp] lemma comp_to_hom (hnp : N ↪[L] P) (hmn : M ↪[L] N) :
  (hnp.comp hmn).to_hom = hnp.to_hom.comp hmn.to_hom :=
by { ext, simp only [coe_to_hom, comp_apply, hom.comp_apply] }

end embedding

namespace equiv

instance : equiv_like (M ≃[L] N) M N :=
{ coe := λ f, f.to_fun,
  inv := λ f, f.inv_fun,
  left_inv := λ f, f.left_inv,
  right_inv := λ f, f.right_inv,
  coe_injective' := λ f g h₁ h₂, begin
    cases f,
    cases g,
    simp only,
    ext x,
    exact function.funext_iff.1 h₁ x,
  end, }

instance : strong_hom_class L (M ≃[L] N) M N :=
{ map_fun := map_fun',
  map_rel := map_rel', }

/-- The inverse of a first-order equivalence is a first-order equivalence. -/
@[symm] def symm (f : M ≃[L] N) : N ≃[L] M :=
{ map_fun' := λ n f' x, begin
    simp only [equiv.to_fun_as_coe],
    rw [equiv.symm_apply_eq],
    refine eq.trans _ (f.map_fun' f' (f.to_equiv.symm ∘ x)).symm,
    rw [← function.comp.assoc, equiv.to_fun_as_coe, equiv.self_comp_symm, function.comp.left_id]
  end,
  map_rel' := λ n r x, begin
    simp only [equiv.to_fun_as_coe],
    refine (f.map_rel' r (f.to_equiv.symm ∘ x)).symm.trans _,
    rw [← function.comp.assoc, equiv.to_fun_as_coe, equiv.self_comp_symm, function.comp.left_id]
  end,
  .. f.to_equiv.symm }

instance has_coe_to_fun : has_coe_to_fun (M ≃[L] N) (λ _, M → N) :=
fun_like.has_coe_to_fun

@[simp]
lemma apply_symm_apply (f : M ≃[L] N) (a : N) : f (f.symm a) = a := f.to_equiv.apply_symm_apply a

@[simp]
lemma symm_apply_apply (f : M ≃[L] N) (a : M) : f.symm (f a) = a := f.to_equiv.symm_apply_apply a

@[simp] lemma map_fun (φ : M ≃[L] N) {n : ℕ} (f : L.functions n) (x : fin n → M) :
  φ (fun_map f x) = fun_map f (φ ∘ x) :=
hom_class.map_fun φ f x

@[simp] lemma map_constants (φ : M ≃[L] N) (c : L.constants) : φ c = c :=
hom_class.map_constants φ c

@[simp] lemma map_rel (φ : M ≃[L] N) {n : ℕ} (r : L.relations n) (x : fin n → M) :
  rel_map r (φ ∘ x) ↔ rel_map r x :=
strong_hom_class.map_rel φ r x

/-- A first-order equivalence is also a first-order embedding. -/
def to_embedding (f : M ≃[L] N) : M ↪[L] N :=
{ to_fun := f,
  inj' := f.to_equiv.injective }

/-- A first-order equivalence is also a first-order homomorphism. -/
def to_hom (f : M ≃[L] N) : M →[L] N :=
{ to_fun := f }

@[simp] lemma to_embedding_to_hom (f : M ≃[L] N) : f.to_embedding.to_hom = f.to_hom := rfl

@[simp]
lemma coe_to_hom {f : M ≃[L] N} : (f.to_hom : M → N) = (f : M → N) := rfl

@[simp] lemma coe_to_embedding (f : M ≃[L] N) : (f.to_embedding : M → N) = (f : M → N) := rfl

lemma coe_injective : @function.injective (M ≃[L] N) (M → N) coe_fn :=
fun_like.coe_injective

@[ext]
lemma ext ⦃f g : M ≃[L] N⦄ (h : ∀ x, f x = g x) : f = g :=
coe_injective (funext h)

lemma ext_iff {f g : M ≃[L] N} : f = g ↔ ∀ x, f x = g x :=
⟨λ h x, h ▸ rfl, λ h, ext h⟩

lemma bijective (f : M ≃[L] N) : function.bijective f := equiv_like.bijective f

lemma injective (f : M ≃[L] N) : function.injective f := equiv_like.injective f

lemma surjective (f : M ≃[L] N) : function.surjective f := equiv_like.surjective f

variables (L) (M)
/-- The identity equivalence from a structure to itself -/
@[refl] def refl : M ≃[L] M :=
{ to_equiv := equiv.refl M }

variables {L} {M}

instance : inhabited (M ≃[L] M) := ⟨refl L M⟩

@[simp] lemma refl_apply (x : M) :
  refl L M x = x := rfl

/-- Composition of first-order equivalences -/
@[trans] def comp (hnp : N ≃[L] P) (hmn : M ≃[L] N) : M ≃[L] P :=
{ to_fun := hnp ∘ hmn,
  .. (hmn.to_equiv.trans hnp.to_equiv) }

@[simp] lemma comp_apply (g : N ≃[L] P) (f : M ≃[L] N) (x : M) :
  g.comp f x = g (f x) := rfl

/-- Composition of first-order homomorphisms is associative. -/
lemma comp_assoc (f : M ≃[L] N) (g : N ≃[L] P) (h : P ≃[L] Q) :
  (h.comp g).comp f = h.comp (g.comp f) := rfl

end equiv

section sum_Structure
variables (L₁ L₂ : language) (S : Type*) [L₁.Structure S] [L₂.Structure S]

instance sum_Structure :
  (L₁.sum L₂).Structure S :=
{ fun_map := λ n, sum.elim fun_map fun_map,
  rel_map := λ n, sum.elim rel_map rel_map, }

variables {L₁ L₂ S}

@[simp] lemma fun_map_sum_inl {n : ℕ} (f : L₁.functions n) :
  @fun_map (L₁.sum L₂) S _ n (sum.inl f) = fun_map f := rfl

@[simp] lemma fun_map_sum_inr {n : ℕ} (f : L₂.functions n) :
  @fun_map (L₁.sum L₂) S _ n (sum.inr f) = fun_map f := rfl

@[simp] lemma rel_map_sum_inl {n : ℕ} (R : L₁.relations n) :
  @rel_map (L₁.sum L₂) S _ n (sum.inl R) = rel_map R := rfl

@[simp] lemma rel_map_sum_inr {n : ℕ} (R : L₂.relations n) :
  @rel_map (L₁.sum L₂) S _ n (sum.inr R) = rel_map R := rfl

end sum_Structure

end language
end first_order

namespace equiv
open first_order first_order.language first_order.language.Structure
open_locale first_order

variables {L : language} {M : Type*} {N : Type*} [L.Structure M]

/-- A structure induced by a bijection. -/
@[simps] def induced_Structure (e : M ≃ N) : L.Structure N :=
⟨λ n f x, e (fun_map f (e.symm ∘ x)), λ n r x, rel_map r (e.symm ∘ x)⟩

/-- A bijection as a first-order isomorphism with the induced structure on the codomain. -/
@[simps] def induced_Structure_equiv (e : M ≃ N) :
  @language.equiv L M N _ (induced_Structure e) :=
{ map_fun' := λ n f x, by simp [← function.comp.assoc e.symm e x],
  map_rel' := λ n r x, by simp [← function.comp.assoc e.symm e x],
  .. e }

end equiv


import set_theory.cardinal.ordinal

open_locale cardinal -- to have notation `ℵ₀`. Plain `open` won't work
open cardinal -- for the namespace

#check (ℵ₀ : cardinal.{0})

#check (ℵ₀ : cardinal.{1}) = (ℵ₀ : cardinal)
-- #check (ℵ₀ : cardinal.{2}) = (ℵ₀ : cardinal.{1}) -- fails
#check (ℵ₀ : cardinal.{2}) = lift.{2 1} (ℵ₀ : cardinal.{1})

example : (ℵ₀ : cardinal.{2}) = lift.{2 1} (ℵ₀ : cardinal.{1}) := by { simp }

namespace cardinal

universes u v

instance coe_card_1 : has_coe cardinal.{u} cardinal.{u+1} := ⟨cardinal.lift.{u+1 u}⟩

end cardinal

#check (ℵ₀ : cardinal.{19}) =  (ℵ₀ : cardinal.{3})

example : (ℵ₀ : cardinal.{19}) =  (ℵ₀ : cardinal.{3}) :=
begin
  unfold coe lift_t has_lift_t.lift coe_t has_coe_t.coe coe_b has_coe.coe,
  simp,
end

namespace inductive_generate

open set

universe u
variables {α : Type u} (s : set (set α))

-- Experimenting with the code provided by Junyan Xu
inductive generate_from (s : set (set α)) : ordinal.{u} → set α → Prop
| basic : ∀ o (u ∈ s), generate_from o u
| empty : ∀ o, generate_from o ∅
| compl : ∀ o u (o' < o), generate_from o' u → generate_from o uᶜ
| union : ∀ o (f : ℕ → set α) (o' : ℕ → ordinal.{u}), (∀ n, o' n < o) →
  (∀ n, generate_from (o' n) (f n)) → generate_from o (⋃ i, f i)

def gen_from_set' (s : set (set α)) : ordinal.{u} → set (set α) := generate_from s

example : gen_from_set' s 0 = s ∪ {∅}:=
begin
  unfold gen_from_set',
  ext, split;
  intro hx,
  { cases hx with _ _ hxins o' o x o ho gensx _ f o' ho'lt geno'f,
    -- record the variables above.
    { exact mem_union_left _ hxins },
    { finish },
    { exfalso,
      exact ordinal.not_lt_zero _ ho },
    { exfalso,
      exact ordinal.not_lt_zero _ (ho'lt 0) },
  },
  { cases hx,
    { exact generate_from.basic 0 x hx }, -- Is there be a better inductive way
    { simp at hx,
      rw hx,
      exact generate_from.empty 0 } } -- than using these `exact`s?
end

/--
First attempt to prove an induction lemma for `generate_from`.
-/
lemma generate_from_induction (s : set (set α)) (P : set α → Prop) (i : ordinal.{u}) (x : set α)
(h_basic : ∀ (x ∈ s), P x)
(h_empty : P ∅)
(h_compl : ∀x, P x → P (xᶜ))
(h_union : ∀ (f : ℕ → set α), (∀ n, P (f n)) → P (⋃ i, f i)) (hsox: generate_from s i x) : P x :=
begin
  induction hsox with o y hxins o' o y o' ho'o gensx IH o f h hnlto genhf IH,
  exacts [h_basic y hxins, h_empty, h_compl y IH, h_union f IH]
end

end inductive_generate

namespace cardinal

universes u v

def equiv_ulift {α β : Type*} (heq : α ≃ β) : (ulift.{u} α) ≃ (ulift.{v} β) :=
begin
  cases heq with tofu infu li ri,
  let ntf := λ (x : ulift.{u} α), ulift.up.{v} (tofu x.down),
  let nif := λ (x : ulift.{v} β), ulift.up.{u} (infu x.down),
  have ntfx : ∀x, ntf x = ulift.up.{v} (tofu x.down) := by simp,
  have nify : ∀y, nif y = ulift.up.{u} (infu y.down) := by simp,
  have nli : function.left_inverse nif ntf,
  { intro x,
    rw [ntfx, nify, li x.down, ulift.up_down] },
  have nri : function.right_inverse nif ntf,
  { intro x,
    rw [ntfx, nify, ri x.down, ulift.up_down] },
  exact ⟨ntf, nif, nli, nri⟩
end

end cardinal


/-
Copyright (c) 2018 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Johan Commelin, Bhavik Mehta

! This file was ported from Lean 3 source module category_theory.comma
! leanprover-community/mathlib commit 8a318021995877a44630c898d0b2bc376fceef3b
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.CategoryTheory.Isomorphism
import Mathbin.CategoryTheory.Functor.Category
import Mathbin.CategoryTheory.EqToHom

/-!
# Comma categories

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

A comma category is a construction in category theory, which builds a category out of two functors
with a common codomain. Specifically, for functors `L : A ⥤ T` and `R : B ⥤ T`, an object in
`comma L R` is a morphism `hom : L.obj left ⟶ R.obj right` for some objects `left : A` and
`right : B`, and a morphism in `comma L R` between `hom : L.obj left ⟶ R.obj right` and
`hom' : L.obj left' ⟶ R.obj right'` is a commutative square

```
L.obj left   ⟶   L.obj left'
      |               |
  hom |               | hom'
      ↓               ↓
R.obj right  ⟶   R.obj right',
```

where the top and bottom morphism come from morphisms `left ⟶ left'` and `right ⟶ right'`,
respectively.

## Main definitions

* `comma L R`: the comma category of the functors `L` and `R`.
* `over X`: the over category of the object `X` (developed in `over.lean`).
* `under X`: the under category of the object `X` (also developed in `over.lean`).
* `arrow T`: the arrow category of the category `T` (developed in `arrow.lean`).

## References

* <https://ncatlab.org/nlab/show/comma+category>

## Tags

comma, slice, coslice, over, under, arrow
-/

namespace CategoryTheory

-- declare the `v`'s first; see `category_theory.category` for an explanation
universe v₁ v₂ v₃ v₄ v₅ u₁ u₂ u₃ u₄ u₅

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

variable {B : Type u₂} [Category.{v₂} B]

variable {T : Type u₃} [Category.{v₃} T]

#print CategoryTheory.Comma /-
/-- The objects of the comma category are triples of an object `left : A`, an object
   `right : B` and a morphism `hom : L.obj left ⟶ R.obj right`.  -/
structure Comma (L : A ⥤ T) (R : B ⥤ T) : Type max u₁ u₂ v₃ where
  left : A
  right : B
  Hom : L.obj left ⟶ R.obj right
#align category_theory.comma CategoryTheory.Comma
-/

#print CategoryTheory.Comma.inhabited /-
-- Satisfying the inhabited linter
instance Comma.inhabited [Inhabited T] : Inhabited (Comma (𝟭 T) (𝟭 T))
    where default :=
    { left := default
      right := default
      Hom := 𝟙 default }
#align category_theory.comma.inhabited CategoryTheory.Comma.inhabited
-/

variable {L : A ⥤ T} {R : B ⥤ T}

#print CategoryTheory.CommaMorphism /-
/-- A morphism between two objects in the comma category is a commutative square connecting the
    morphisms coming from the two objects using morphisms in the image of the functors `L` and `R`.
-/
@[ext]
structure CommaMorphism (X Y : Comma L R) where
  left : X.left ⟶ Y.left
  right : X.right ⟶ Y.right
  w' : L.map left ≫ Y.Hom = X.Hom ≫ R.map right := by obviously
#align category_theory.comma_morphism CategoryTheory.CommaMorphism
-/

#print CategoryTheory.CommaMorphism.inhabited /-
-- Satisfying the inhabited linter
instance CommaMorphism.inhabited [Inhabited (Comma L R)] :
    Inhabited (CommaMorphism (default : Comma L R) default) :=
  ⟨⟨𝟙 _, 𝟙 _⟩⟩
#align category_theory.comma_morphism.inhabited CategoryTheory.CommaMorphism.inhabited
-/

restate_axiom comma_morphism.w'

attribute [simp, reassoc.1] comma_morphism.w

#print CategoryTheory.commaCategory /-
instance commaCategory : Category (Comma L R)
    where
  Hom := CommaMorphism
  id X :=
    { left := 𝟙 X.left
      right := 𝟙 X.right }
  comp X Y Z f g :=
    { left := f.left ≫ g.left
      right := f.right ≫ g.right }
#align category_theory.comma_category CategoryTheory.commaCategory
-/

namespace Comma

section

variable {X Y Z : Comma L R} {f : X ⟶ Y} {g : Y ⟶ Z}

#print CategoryTheory.Comma.id_left /-
@[simp]
theorem id_left : (𝟙 X : CommaMorphism X X).left = 𝟙 X.left :=
  rfl
#align category_theory.comma.id_left CategoryTheory.Comma.id_left
-/

#print CategoryTheory.Comma.id_right /-
@[simp]
theorem id_right : (𝟙 X : CommaMorphism X X).right = 𝟙 X.right :=
  rfl
#align category_theory.comma.id_right CategoryTheory.Comma.id_right
-/

#print CategoryTheory.Comma.comp_left /-
@[simp]
theorem comp_left : (f ≫ g).left = f.left ≫ g.left :=
  rfl
#align category_theory.comma.comp_left CategoryTheory.Comma.comp_left
-/

#print CategoryTheory.Comma.comp_right /-
@[simp]
theorem comp_right : (f ≫ g).right = f.right ≫ g.right :=
  rfl
#align category_theory.comma.comp_right CategoryTheory.Comma.comp_right
-/

end

variable (L) (R)

#print CategoryTheory.Comma.fst /-
/-- The functor sending an object `X` in the comma category to `X.left`. -/
@[simps]
def fst : Comma L R ⥤ A where
  obj X := X.left
  map _ _ f := f.left
#align category_theory.comma.fst CategoryTheory.Comma.fst
-/

#print CategoryTheory.Comma.snd /-
/-- The functor sending an object `X` in the comma category to `X.right`. -/
@[simps]
def snd : Comma L R ⥤ B where
  obj X := X.right
  map _ _ f := f.right
#align category_theory.comma.snd CategoryTheory.Comma.snd
-/

#print CategoryTheory.Comma.natTrans /-
/-- We can interpret the commutative square constituting a morphism in the comma category as a
    natural transformation between the functors `fst ⋙ L` and `snd ⋙ R` from the comma category
    to `T`, where the components are given by the morphism that constitutes an object of the comma
    category. -/
@[simps]
def natTrans : fst L R ⋙ L ⟶ snd L R ⋙ R where app X := X.Hom
#align category_theory.comma.nat_trans CategoryTheory.Comma.natTrans
-/

#print CategoryTheory.Comma.eqToHom_left /-
@[simp]
theorem eqToHom_left (X Y : Comma L R) (H : X = Y) :
    CommaMorphism.left (eqToHom H) =
      eqToHom
        (by
          cases H
          rfl) :=
  by
  cases H
  rfl
#align category_theory.comma.eq_to_hom_left CategoryTheory.Comma.eqToHom_left
-/

#print CategoryTheory.Comma.eqToHom_right /-
@[simp]
theorem eqToHom_right (X Y : Comma L R) (H : X = Y) :
    CommaMorphism.right (eqToHom H) =
      eqToHom
        (by
          cases H
          rfl) :=
  by
  cases H
  rfl
#align category_theory.comma.eq_to_hom_right CategoryTheory.Comma.eqToHom_right
-/

section

variable {L₁ L₂ L₃ : A ⥤ T} {R₁ R₂ R₃ : B ⥤ T}

/- warning: category_theory.comma.iso_mk -> CategoryTheory.Comma.isoMk is a dubious translation:
lean 3 declaration is
  forall {A : Type.{u4}} [_inst_1 : CategoryTheory.Category.{u1, u4} A] {B : Type.{u5}} [_inst_2 : CategoryTheory.Category.{u2, u5} B] {T : Type.{u6}} [_inst_3 : CategoryTheory.Category.{u3, u6} T] {L₁ : CategoryTheory.Functor.{u1, u3, u4, u6} A _inst_1 T _inst_3} {R₁ : CategoryTheory.Functor.{u2, u3, u5, u6} B _inst_2 T _inst_3} {X : CategoryTheory.Comma.{u1, u2, u3, u4, u5, u6} A _inst_1 B _inst_2 T _inst_3 L₁ R₁} {Y : CategoryTheory.Comma.{u1, u2, u3, u4, u5, u6} A _inst_1 B _inst_2 T _inst_3 L₁ R₁} (l : CategoryTheory.Iso.{u1, u4} A _inst_1 (CategoryTheory.Comma.left.{u1, u2, u3, u4, u5, u6} A _inst_1 B _inst_2 T _inst_3 L₁ R₁ X) (CategoryTheory.Comma.left.{u1, u2, u3, u4, u5, u6} A _inst_1 B _inst_2 T _inst_3 L₁ R₁ Y)) (r : CategoryTheory.Iso.{u2, u5} B _inst_2 (CategoryTheory.Comma.right.{u1, u2, u3, u4, u5, u6} A _inst_1 B _inst_2 T _inst_3 L₁ R₁ X) (CategoryTheory.Comma.right.{u1, u2, u3, u4, u5, u6} A _inst_1 B _inst_2 T _inst_3 L₁ R₁ Y)), (Eq.{succ u3} (Quiver.Hom.{succ u3, u6} T (CategoryTheory.CategoryStruct.toQuiver.{u3, u6} T (CategoryTheory.Category.toCategoryStruct.{u3, u6} T _inst_3)) (CategoryTheory.Functor.obj.{u1, u3, u4, u6} A _inst_1 T _inst_3 L₁ (CategoryTheory.Comma.left.{u1, u2, u3, u4, u5, u6} A _inst_1 B _inst_2 T _inst_3 L₁ R₁ X)) (CategoryTheory.Functor.obj.{u2, u3, u5, u6} B _inst_2 T _inst_3 R₁ (CategoryTheory.Comma.right.{u1, u2, u3, u4, u5, u6} A _inst_1 B _inst_2 T _inst_3 L₁ R₁ Y))) (CategoryTheory.CategoryStruct.comp.{u3, u6} T (CategoryTheory.Category.toCategoryStruct.{u3, u6} T _inst_3) (CategoryTheory.Functor.obj.{u1, u3, u4, u6} A _inst_1 T _inst_3 L₁ (CategoryTheory.Comma.left.{u1, u2, u3, u4, u5, u6} A _inst_1 B _inst_2 T _inst_3 L₁ R₁ X)) (CategoryTheory.Functor.obj.{u1, u3, u4, u6} A _inst_1 T _inst_3 L₁ (CategoryTheory.Comma.left.{u1, u2, u3, u4, u5, u6} A _inst_1 B _inst_2 T _inst_3 L₁ R₁ Y)) (CategoryTheory.Functor.obj.{u2, u3, u5, u6} B _inst_2 T _inst_3 R₁ (CategoryTheory.Comma.right.{u1, u2, u3, u4, u5, u6} A _inst_1 B _inst_2 T _inst_3 L₁ R₁ Y)) (CategoryTheory.Functor.map.{u1, u3, u4, u6} A _inst_1 T _inst_3 L₁ (CategoryTheory.Comma.left.{u1, u2, u3, u4, u5, u6} A _inst_1 B _inst_2 T _inst_3 L₁ R₁ X) (CategoryTheory.Comma.left.{u1, u2, u3, u4, u5, u6} A _inst_1 B _inst_2 T _inst_3 L₁ R₁ Y) (CategoryTheory.Iso.hom.{u1, u4} A _inst_1 (CategoryTheory.Comma.left.{u1, u2, u3, u4, u5, u6} A _inst_1 B _inst_2 T _inst_3 L₁ R₁ X) (CategoryTheory.Comma.left.{u1, u2, u3, u4, u5, u6} A _inst_1 B _inst_2 T _inst_3 L₁ R₁ Y) l)) (CategoryTheory.Comma.hom.{u1, u2, u3, u4, u5, u6} A _inst_1 B _inst_2 T _inst_3 L₁ R₁ Y)) (CategoryTheory.CategoryStruct.comp.{u3, u6} T (CategoryTheory.Category.toCategoryStruct.{u3, u6} T _inst_3) (CategoryTheory.Functor.obj.{u1, u3, u4, u6} A _inst_1 T _inst_3 L₁ (CategoryTheory.Comma.left.{u1, u2, u3, u4, u5, u6} A _inst_1 B _inst_2 T _inst_3 L₁ R₁ X)) (CategoryTheory.Functor.obj.{u2, u3, u5, u6} B _inst_2 T _inst_3 R₁ (CategoryTheory.Comma.right.{u1, u2, u3, u4, u5, u6} A _inst_1 B _inst_2 T _inst_3 L₁ R₁ X)) (CategoryTheory.Functor.obj.{u2, u3, u5, u6} B _inst_2 T _inst_3 R₁ (CategoryTheory.Comma.right.{u1, u2, u3, u4, u5, u6} A _inst_1 B _inst_2 T _inst_3 L₁ R₁ Y)) (CategoryTheory.Comma.hom.{u1, u2, u3, u4, u5, u6} A _inst_1 B _inst_2 T _inst_3 L₁ R₁ X) (CategoryTheory.Functor.map.{u2, u3, u5, u6} B _inst_2 T _inst_3 R₁ (CategoryTheory.Comma.right.{u1, u2, u3, u4, u5, u6} A _inst_1 B _inst_2 T _inst_3 L₁ R₁ X) (CategoryTheory.Comma.right.{u1, u2, u3, u4, u5, u6} A _inst_1 B _inst_2 T _inst_3 L₁ R₁ Y) (CategoryTheory.Iso.hom.{u2, u5} B _inst_2 (CategoryTheory.Comma.right.{u1, u2, u3, u4, u5, u6} A _inst_1 B _inst_2 T _inst_3 L₁ R₁ X) (CategoryTheory.Comma.right.{u1, u2, u3, u4, u5, u6} A _inst_1 B _inst_2 T _inst_3 L₁ R₁ Y) r)))) -> (CategoryTheory.Iso.{max u1 u2, max u4 u5 u3} (CategoryTheory.Comma.{u1, u2, u3, u4, u5, u6} A _inst_1 B _inst_2 T _inst_3 L₁ R₁) (CategoryTheory.commaCategory.{u1, u2, u3, u4, u5, u6} A _inst_1 B _inst_2 T _inst_3 L₁ R₁) X Y)
but is expected to have type
  forall {A : Type.{u4}} [_inst_1 : CategoryTheory.Category.{u1, u4} A] {B : Type.{u5}} [_inst_2 : CategoryTheory.Category.{u2, u5} B] {T : Type.{u6}} [_inst_3 : CategoryTheory.Category.{u3, u6} T] {L₁ : CategoryTheory.Functor.{u1, u3, u4, u6} A _inst_1 T _inst_3} {R₁ : CategoryTheory.Functor.{u2, u3, u5, u6} B _inst_2 T _inst_3} {X : CategoryTheory.Comma.{u1, u2, u3, u4, u5, u6} A _inst_1 B _inst_2 T _inst_3 L₁ R₁} {Y : CategoryTheory.Comma.{u1, u2, u3, u4, u5, u6} A _inst_1 B _inst_2 T _inst_3 L₁ R₁} (l : CategoryTheory.Iso.{u1, u4} A _inst_1 (CategoryTheory.Comma.left.{u1, u2, u3, u4, u5, u6} A _inst_1 B _inst_2 T _inst_3 L₁ R₁ X) (CategoryTheory.Comma.left.{u1, u2, u3, u4, u5, u6} A _inst_1 B _inst_2 T _inst_3 L₁ R₁ Y)) (r : CategoryTheory.Iso.{u2, u5} B _inst_2 (CategoryTheory.Comma.right.{u1, u2, u3, u4, u5, u6} A _inst_1 B _inst_2 T _inst_3 L₁ R₁ X) (CategoryTheory.Comma.right.{u1, u2, u3, u4, u5, u6} A _inst_1 B _inst_2 T _inst_3 L₁ R₁ Y)), (Eq.{succ u3} (Quiver.Hom.{succ u3, u6} T (CategoryTheory.CategoryStruct.toQuiver.{u3, u6} T (CategoryTheory.Category.toCategoryStruct.{u3, u6} T _inst_3)) (Prefunctor.obj.{succ u1, succ u3, u4, u6} A (CategoryTheory.CategoryStruct.toQuiver.{u1, u4} A (CategoryTheory.Category.toCategoryStruct.{u1, u4} A _inst_1)) T (CategoryTheory.CategoryStruct.toQuiver.{u3, u6} T (CategoryTheory.Category.toCategoryStruct.{u3, u6} T _inst_3)) (CategoryTheory.Functor.toPrefunctor.{u1, u3, u4, u6} A _inst_1 T _inst_3 L₁) (CategoryTheory.Comma.left.{u1, u2, u3, u4, u5, u6} A _inst_1 B _inst_2 T _inst_3 L₁ R₁ X)) (Prefunctor.obj.{succ u2, succ u3, u5, u6} B (CategoryTheory.CategoryStruct.toQuiver.{u2, u5} B (CategoryTheory.Category.toCategoryStruct.{u2, u5} B _inst_2)) T (CategoryTheory.CategoryStruct.toQuiver.{u3, u6} T (CategoryTheory.Category.toCategoryStruct.{u3, u6} T _inst_3)) (CategoryTheory.Functor.toPrefunctor.{u2, u3, u5, u6} B _inst_2 T _inst_3 R₁) (CategoryTheory.Comma.right.{u1, u2, u3, u4, u5, u6} A _inst_1 B _inst_2 T _inst_3 L₁ R₁ Y))) (CategoryTheory.CategoryStruct.comp.{u3, u6} T (CategoryTheory.Category.toCategoryStruct.{u3, u6} T _inst_3) (Prefunctor.obj.{succ u1, succ u3, u4, u6} A (CategoryTheory.CategoryStruct.toQuiver.{u1, u4} A (CategoryTheory.Category.toCategoryStruct.{u1, u4} A _inst_1)) T (CategoryTheory.CategoryStruct.toQuiver.{u3, u6} T (CategoryTheory.Category.toCategoryStruct.{u3, u6} T _inst_3)) (CategoryTheory.Functor.toPrefunctor.{u1, u3, u4, u6} A _inst_1 T _inst_3 L₁) (CategoryTheory.Comma.left.{u1, u2, u3, u4, u5, u6} A _inst_1 B _inst_2 T _inst_3 L₁ R₁ X)) (Prefunctor.obj.{succ u1, succ u3, u4, u6} A (CategoryTheory.CategoryStruct.toQuiver.{u1, u4} A (CategoryTheory.Category.toCategoryStruct.{u1, u4} A _inst_1)) T (CategoryTheory.CategoryStruct.toQuiver.{u3, u6} T (CategoryTheory.Category.toCategoryStruct.{u3, u6} T _inst_3)) (CategoryTheory.Functor.toPrefunctor.{u1, u3, u4, u6} A _inst_1 T _inst_3 L₁) (CategoryTheory.Comma.left.{u1, u2, u3, u4, u5, u6} A _inst_1 B _inst_2 T _inst_3 L₁ R₁ Y)) (Prefunctor.obj.{succ u2, succ u3, u5, u6} B (CategoryTheory.CategoryStruct.toQuiver.{u2, u5} B (CategoryTheory.Category.toCategoryStruct.{u2, u5} B _inst_2)) T (CategoryTheory.CategoryStruct.toQuiver.{u3, u6} T (CategoryTheory.Category.toCategoryStruct.{u3, u6} T _inst_3)) (CategoryTheory.Functor.toPrefunctor.{u2, u3, u5, u6} B _inst_2 T _inst_3 R₁) (CategoryTheory.Comma.right.{u1, u2, u3, u4, u5, u6} A _inst_1 B _inst_2 T _inst_3 L₁ R₁ Y)) (Prefunctor.map.{succ u1, succ u3, u4, u6} A (CategoryTheory.CategoryStruct.toQuiver.{u1, u4} A (CategoryTheory.Category.toCategoryStruct.{u1, u4} A _inst_1)) T (CategoryTheory.CategoryStruct.toQuiver.{u3, u6} T (CategoryTheory.Category.toCategoryStruct.{u3, u6} T _inst_3)) (CategoryTheory.Functor.toPrefunctor.{u1, u3, u4, u6} A _inst_1 T _inst_3 L₁) (CategoryTheory.Comma.left.{u1, u2, u3, u4, u5, u6} A _inst_1 B _inst_2 T _inst_3 L₁ R₁ X) (CategoryTheory.Comma.left.{u1, u2, u3, u4, u5, u6} A _inst_1 B _inst_2 T _inst_3 L₁ R₁ Y) (CategoryTheory.Iso.hom.{u1, u4} A _inst_1 (CategoryTheory.Comma.left.{u1, u2, u3, u4, u5, u6} A _inst_1 B _inst_2 T _inst_3 L₁ R₁ X) (CategoryTheory.Comma.left.{u1, u2, u3, u4, u5, u6} A _inst_1 B _inst_2 T _inst_3 L₁ R₁ Y) l)) (CategoryTheory.Comma.hom.{u1, u2, u3, u4, u5, u6} A _inst_1 B _inst_2 T _inst_3 L₁ R₁ Y)) (CategoryTheory.CategoryStruct.comp.{u3, u6} T (CategoryTheory.Category.toCategoryStruct.{u3, u6} T _inst_3) (Prefunctor.obj.{succ u1, succ u3, u4, u6} A (CategoryTheory.CategoryStruct.toQuiver.{u1, u4} A (CategoryTheory.Category.toCategoryStruct.{u1, u4} A _inst_1)) T (CategoryTheory.CategoryStruct.toQuiver.{u3, u6} T (CategoryTheory.Category.toCategoryStruct.{u3, u6} T _inst_3)) (CategoryTheory.Functor.toPrefunctor.{u1, u3, u4, u6} A _inst_1 T _inst_3 L₁) (CategoryTheory.Comma.left.{u1, u2, u3, u4, u5, u6} A _inst_1 B _inst_2 T _inst_3 L₁ R₁ X)) (Prefunctor.obj.{succ u2, succ u3, u5, u6} B (CategoryTheory.CategoryStruct.toQuiver.{u2, u5} B (CategoryTheory.Category.toCategoryStruct.{u2, u5} B _inst_2)) T (CategoryTheory.CategoryStruct.toQuiver.{u3, u6} T (CategoryTheory.Category.toCategoryStruct.{u3, u6} T _inst_3)) (CategoryTheory.Functor.toPrefunctor.{u2, u3, u5, u6} B _inst_2 T _inst_3 R₁) (CategoryTheory.Comma.right.{u1, u2, u3, u4, u5, u6} A _inst_1 B _inst_2 T _inst_3 L₁ R₁ X)) (Prefunctor.obj.{succ u2, succ u3, u5, u6} B (CategoryTheory.CategoryStruct.toQuiver.{u2, u5} B (CategoryTheory.Category.toCategoryStruct.{u2, u5} B _inst_2)) T (CategoryTheory.CategoryStruct.toQuiver.{u3, u6} T (CategoryTheory.Category.toCategoryStruct.{u3, u6} T _inst_3)) (CategoryTheory.Functor.toPrefunctor.{u2, u3, u5, u6} B _inst_2 T _inst_3 R₁) (CategoryTheory.Comma.right.{u1, u2, u3, u4, u5, u6} A _inst_1 B _inst_2 T _inst_3 L₁ R₁ Y)) (CategoryTheory.Comma.hom.{u1, u2, u3, u4, u5, u6} A _inst_1 B _inst_2 T _inst_3 L₁ R₁ X) (Prefunctor.map.{succ u2, succ u3, u5, u6} B (CategoryTheory.CategoryStruct.toQuiver.{u2, u5} B (CategoryTheory.Category.toCategoryStruct.{u2, u5} B _inst_2)) T (CategoryTheory.CategoryStruct.toQuiver.{u3, u6} T (CategoryTheory.Category.toCategoryStruct.{u3, u6} T _inst_3)) (CategoryTheory.Functor.toPrefunctor.{u2, u3, u5, u6} B _inst_2 T _inst_3 R₁) (CategoryTheory.Comma.right.{u1, u2, u3, u4, u5, u6} A _inst_1 B _inst_2 T _inst_3 L₁ R₁ X) (CategoryTheory.Comma.right.{u1, u2, u3, u4, u5, u6} A _inst_1 B _inst_2 T _inst_3 L₁ R₁ Y) (CategoryTheory.Iso.hom.{u2, u5} B _inst_2 (CategoryTheory.Comma.right.{u1, u2, u3, u4, u5, u6} A _inst_1 B _inst_2 T _inst_3 L₁ R₁ X) (CategoryTheory.Comma.right.{u1, u2, u3, u4, u5, u6} A _inst_1 B _inst_2 T _inst_3 L₁ R₁ Y) r)))) -> (CategoryTheory.Iso.{max u1 u2, max (max u4 u5) u3} (CategoryTheory.Comma.{u1, u2, u3, u4, u5, u6} A _inst_1 B _inst_2 T _inst_3 L₁ R₁) (CategoryTheory.commaCategory.{u1, u2, u3, u4, u5, u6} A _inst_1 B _inst_2 T _inst_3 L₁ R₁) X Y)
Case conversion may be inaccurate. Consider using '#align category_theory.comma.iso_mk CategoryTheory.Comma.isoMkₓ'. -/
/-- Construct an isomorphism in the comma category given isomorphisms of the objects whose forward
directions give a commutative square.
-/
@[simps]
def isoMk {X Y : Comma L₁ R₁} (l : X.left ≅ Y.left) (r : X.right ≅ Y.right)
    (h : L₁.map l.Hom ≫ Y.Hom = X.Hom ≫ R₁.map r.Hom) : X ≅ Y
    where
  Hom :=
    { left := l.Hom
      right := r.Hom }
  inv :=
    { left := l.inv
      right := r.inv
      w' :=
        by
        rw [← L₁.map_iso_inv l, iso.inv_comp_eq, L₁.map_iso_hom, reassoc_of h, ← R₁.map_comp]
        simp }
#align category_theory.comma.iso_mk CategoryTheory.Comma.isoMk

#print CategoryTheory.Comma.mapLeft /-
/-- A natural transformation `L₁ ⟶ L₂` induces a functor `comma L₂ R ⥤ comma L₁ R`. -/
@[simps]
def mapLeft (l : L₁ ⟶ L₂) : Comma L₂ R ⥤ Comma L₁ R
    where
  obj X :=
    { left := X.left
      right := X.right
      Hom := l.app X.left ≫ X.Hom }
  map X Y f :=
    { left := f.left
      right := f.right }
#align category_theory.comma.map_left CategoryTheory.Comma.mapLeft
-/

#print CategoryTheory.Comma.mapLeftId /-
/-- The functor `comma L R ⥤ comma L R` induced by the identity natural transformation on `L` is
    naturally isomorphic to the identity functor. -/
@[simps]
def mapLeftId : mapLeft R (𝟙 L) ≅ 𝟭 _
    where
  Hom :=
    {
      app := fun X =>
        { left := 𝟙 _
          right := 𝟙 _ } }
  inv :=
    {
      app := fun X =>
        { left := 𝟙 _
          right := 𝟙 _ } }
#align category_theory.comma.map_left_id CategoryTheory.Comma.mapLeftId
-/

#print CategoryTheory.Comma.mapLeftComp /-
/-- The functor `comma L₁ R ⥤ comma L₃ R` induced by the composition of two natural transformations
    `l : L₁ ⟶ L₂` and `l' : L₂ ⟶ L₃` is naturally isomorphic to the composition of the two functors
    induced by these natural transformations. -/
@[simps]
def mapLeftComp (l : L₁ ⟶ L₂) (l' : L₂ ⟶ L₃) : mapLeft R (l ≫ l') ≅ mapLeft R l' ⋙ mapLeft R l
    where
  Hom :=
    {
      app := fun X =>
        { left := 𝟙 _
          right := 𝟙 _ } }
  inv :=
    {
      app := fun X =>
        { left := 𝟙 _
          right := 𝟙 _ } }
#align category_theory.comma.map_left_comp CategoryTheory.Comma.mapLeftComp
-/

#print CategoryTheory.Comma.mapRight /-
/-- A natural transformation `R₁ ⟶ R₂` induces a functor `comma L R₁ ⥤ comma L R₂`. -/
@[simps]
def mapRight (r : R₁ ⟶ R₂) : Comma L R₁ ⥤ Comma L R₂
    where
  obj X :=
    { left := X.left
      right := X.right
      Hom := X.Hom ≫ r.app X.right }
  map X Y f :=
    { left := f.left
      right := f.right }
#align category_theory.comma.map_right CategoryTheory.Comma.mapRight
-/

#print CategoryTheory.Comma.mapRightId /-
/-- The functor `comma L R ⥤ comma L R` induced by the identity natural transformation on `R` is
    naturally isomorphic to the identity functor. -/
@[simps]
def mapRightId : mapRight L (𝟙 R) ≅ 𝟭 _
    where
  Hom :=
    {
      app := fun X =>
        { left := 𝟙 _
          right := 𝟙 _ } }
  inv :=
    {
      app := fun X =>
        { left := 𝟙 _
          right := 𝟙 _ } }
#align category_theory.comma.map_right_id CategoryTheory.Comma.mapRightId
-/

#print CategoryTheory.Comma.mapRightComp /-
/-- The functor `comma L R₁ ⥤ comma L R₃` induced by the composition of the natural transformations
    `r : R₁ ⟶ R₂` and `r' : R₂ ⟶ R₃` is naturally isomorphic to the composition of the functors
    induced by these natural transformations. -/
@[simps]
def mapRightComp (r : R₁ ⟶ R₂) (r' : R₂ ⟶ R₃) : mapRight L (r ≫ r') ≅ mapRight L r ⋙ mapRight L r'
    where
  Hom :=
    {
      app := fun X =>
        { left := 𝟙 _
          right := 𝟙 _ } }
  inv :=
    {
      app := fun X =>
        { left := 𝟙 _
          right := 𝟙 _ } }
#align category_theory.comma.map_right_comp CategoryTheory.Comma.mapRightComp
-/

end

section

variable {C : Type u₄} [Category.{v₄} C] {D : Type u₅} [Category.{v₅} D]

#print CategoryTheory.Comma.preLeft /-
/-- The functor `(F ⋙ L, R) ⥤ (L, R)` -/
@[simps]
def preLeft (F : C ⥤ A) (L : A ⥤ T) (R : B ⥤ T) : Comma (F ⋙ L) R ⥤ Comma L R
    where
  obj X :=
    { left := F.obj X.left
      right := X.right
      Hom := X.Hom }
  map X Y f :=
    { left := F.map f.left
      right := f.right
      w' := by simpa using f.w }
#align category_theory.comma.pre_left CategoryTheory.Comma.preLeft
-/

#print CategoryTheory.Comma.preRight /-
/-- The functor `(F ⋙ L, R) ⥤ (L, R)` -/
@[simps]
def preRight (L : A ⥤ T) (F : C ⥤ B) (R : B ⥤ T) : Comma L (F ⋙ R) ⥤ Comma L R
    where
  obj X :=
    { left := X.left
      right := F.obj X.right
      Hom := X.Hom }
  map X Y f :=
    { left := f.left
      right := F.map f.right
      w' := by simp }
#align category_theory.comma.pre_right CategoryTheory.Comma.preRight
-/

#print CategoryTheory.Comma.post /-
/-- The functor `(L, R) ⥤ (L ⋙ F, R ⋙ F)` -/
@[simps]
def post (L : A ⥤ T) (R : B ⥤ T) (F : T ⥤ C) : Comma L R ⥤ Comma (L ⋙ F) (R ⋙ F)
    where
  obj X :=
    { left := X.left
      right := X.right
      Hom := F.map X.Hom }
  map X Y f :=
    { left := f.left
      right := f.right
      w' := by simp only [functor.comp_map, ← F.map_comp, f.w] }
#align category_theory.comma.post CategoryTheory.Comma.post
-/

end

end Comma

end CategoryTheory