import set_theory.ordinal
import tactic.linarith

open set classical

universes u

variables {α : Type u} {m : ℕ} {n : ℕ}

def lift_value (is : fin m) (h : m ≤ n) : fin n :=
  let i := is.val in
  let hi : i < m := is.property in
  ⟨i, gt_of_ge_of_gt h hi⟩

-- instance nat_to_subtype : has_coe ℕ Type := ⟨λ (n : ℕ), {m // m < n}⟩
notation A `^` n := n.to_type → A

def finite_sequence (α : Type u) (n : ℕ) := fin n → α
def infinite_sequence (α : Type*) := ℕ → α

notation A `^<ℕ` := Σ(n : ℕ), finite_sequence A n
notation A `^ℕ` := infinite_sequence A

namespace finite_sequence

def length (s : α^<ℕ) : ℕ := s.fst

def initial_segment (s : finite_sequence α n) (h : m ≤ n) : finite_sequence α m :=
  λ i, s (lift_value i h)

def initial_segment_of (s : finite_sequence α m) (t : finite_sequence α n) : Prop :=
  if h : m ≤ n then s = t.initial_segment h
  else false

def extension_of (t : finite_sequence α n) (s : finite_sequence α m) : Prop :=
  initial_segment_of s t

def compatible (s : finite_sequence α m) (t : finite_sequence α n) : Prop :=
  initial_segment_of s t ∨ extension_of s t

notation s `⊥` t := ¬(compatible s t)

def concat (s : finite_sequence α m) (t : finite_sequence α n) : finite_sequence α (m + n) :=
  λ is, let i := is.val in let hi := is.property in
  if h : i < m then s ⟨i, h⟩
  else
    have h2 : i - m < n, {
      simp at h,
      have h4 := (@nat.sub_lt_right_iff_lt_add i n m h).2,
      apply h4,
      rwa nat.add_comm n m,
    },
    t ⟨i - m, h2⟩

theorem initial_segment_of_concat (s : finite_sequence α m) (t : finite_sequence α n)
    : s.initial_segment_of (s.concat t) := begin
  unfold initial_segment_of, unfold initial_segment, unfold lift_value, simp,
  apply funext, intro is, unfold concat, simp, split_ifs, refl,
  have x := h is.property, exfalso, exact x,
end

end finite_sequence

namespace infinite_sequence

def initial_segment (s : α^ℕ) (m : ℕ) : finite_sequence α m := λ is, s is

def initial_segment_of (s : finite_sequence α m) (t : α^ℕ) : Prop :=
  s = initial_segment t m

def concat (s : finite_sequence α m) (t : α^ℕ) : α^ℕ :=
  λ i, if h : i < m then s ⟨i, h⟩
    else t (i - m)

theorem initial_segment_of_concat (s : finite_sequence α m) (t : α^ℕ)
    : initial_segment_of s (concat s t) := begin
  unfold initial_segment_of, unfold initial_segment, apply funext, intro is,
  unfold concat, split_ifs, simp, exfalso, exact h is.property,
end

def concat_sequence : ℕ → ((α^<ℕ)^ℕ) → α
| i := λ (sᵢ : (α^<ℕ)^ℕ), let ⟨m, s₀⟩ := sᵢ 0 in
  if h : i < m then s₀ ⟨i, h⟩
  else concat_sequence  (i - m) (λ j, sᵢ j + 1)

end infinite_sequence


/-
Copyright (c) 2020 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau

! This file was ported from Lean 3 source module ring_theory.valuation.integral
! leanprover-community/mathlib commit 9b2660e1b25419042c8da10bf411aa3c67f14383
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.RingTheory.IntegrallyClosed
import Mathbin.RingTheory.Valuation.Integers

/-!
# Integral elements over the ring of integers of a valution

The ring of integers is integrally closed inside the original ring.
-/

universe u v w

open BigOperators

namespace Valuation

namespace Integers

section CommRing

variable {R : Type u} {Γ₀ : Type v} [CommRing R] [LinearOrderedCommGroupWithZero Γ₀]

variable {v : Valuation R Γ₀} {O : Type w} [CommRing O] [Algebra O R] (hv : Integers v O)

include hv

open Polynomial

theorem mem_of_integral {x : R} (hx : IsIntegral O x) : x ∈ v.integer :=
  let ⟨p, hpm, hpx⟩ := hx
  le_of_not_lt fun hvx : 1 < v x =>
    by
    rw [hpm.as_sum, eval₂_add, eval₂_pow, eval₂_X, eval₂_finset_sum, add_eq_zero_iff_eq_neg] at hpx
    replace hpx := congr_arg v hpx; refine' ne_of_gt _ hpx
    rw [v.map_neg, v.map_pow]
    refine' v.map_sum_lt' (zero_lt_one.trans_le (one_le_pow_of_one_le' hvx.le _)) fun i hi => _
    rw [eval₂_mul, eval₂_pow, eval₂_C, eval₂_X, v.map_mul, v.map_pow, ←
      one_mul (v x ^ p.nat_degree)]
    cases' (hv.2 <| p.coeff i).lt_or_eq with hvpi hvpi
    · exact mul_lt_mul₀ hvpi (pow_lt_pow₀ hvx <| Finset.mem_range.1 hi)
    · erw [hvpi]
      rw [one_mul, one_mul]
      exact pow_lt_pow₀ hvx (Finset.mem_range.1 hi)
#align valuation.integers.mem_of_integral Valuation.Integers.mem_of_integral

protected theorem integralClosure : integralClosure O R = ⊥ :=
  bot_unique fun r hr =>
    let ⟨x, hx⟩ := hv.3 (hv.mem_of_integral hr)
    Algebra.mem_bot.2 ⟨x, hx⟩
#align valuation.integers.integral_closure Valuation.Integers.integralClosure

end CommRing

section FractionField

variable {K : Type u} {Γ₀ : Type v} [Field K] [LinearOrderedCommGroupWithZero Γ₀]

variable {v : Valuation K Γ₀} {O : Type w} [CommRing O] [IsDomain O]

variable [Algebra O K] [IsFractionRing O K]

variable (hv : Integers v O)

theorem integrallyClosed : IsIntegrallyClosed O :=
  (IsIntegrallyClosed.integralClosure_eq_bot_iff K).mp (Valuation.Integers.integralClosure hv)
#align valuation.integers.integrally_closed Valuation.Integers.integrallyClosed

end FractionField

end Integers

end Valuation


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

lemma mul_le_mul_left1 {a b c : ℝ} (h1 : 0 ≤ a) (h2 : b ≤ c) : a * b ≤ a * c :=
begin
have f1 : 0 ≤ c -b, linarith,
have f2 : 0 ≤ a * (c-b), exact mul_nonneg h1 f1,
have f3 : 0 ≤ a * c - a * b, linarith,
linarith,
end

lemma mul_le_mul_right1 {a b c : ℝ} (h1 : 0 ≤ a) (h2 : b ≤ c) : b * a ≤ c * a :=
begin
have f1 : 0 ≤ c -b, linarith,
have f2 : 0 ≤ a * (c-b), exact mul_nonneg h1 f1,
have f3 : 0 ≤ a * c - a * b, linarith,
linarith,
end

lemma add_le_add_right1 {a b c d: ℝ} ( h1 : b ≤ c) (h2 : a ≤ d): b +a ≤ c + d :=
begin
linarith,
end

lemma le_if_mul_le_mul {a b c : ℝ} (h1 : 0 ≤ a) (h2 : a ≤ b) (h3 : 0 ≤ c) : a ≤ b → a * c ≤ b * c :=
begin
    intro h,
    exact mul_le_mul_right1 h3 h2,

end

lemma div_div_self1 {a b : ℝ} (h1 : 0 < a) (h2 : 0 < b) : a / (a / b) = b :=
begin
  ring_nf,
  rw inv_mul',
  rw inv_inv,
  ring_nf,
  sorry,
end

lemma mul_div_mul_self {a b c : ℝ} (h1 : 0 < a) (h2 : 0 < c) :  (b * a) / (c * a) = b/ c :=
begin
  sorry,
  /-
  have f1 : 0 < c * a, exact mul_pos h2 h1,
  rw div_mul_eq_div_div_swap,
  have P := div_div_self' _ _,
  -/

end

lemma eps_by_2_div_pos {b ε : ℝ} (hε : 0 < ε) (hb :0 < b) : 0 < ε / (2 * b) :=
begin
    have f1 : 0 < 2 * b, linarith,
    exact div_pos hε f1,

end

lemma pos_mul_pos_add_pos_mul_pos_le {a b c d e f: ℝ} (ha : 0 ≤ a) (hd : 0 ≤ d)
(he: 0 ≤ e) (hf : 0 ≤ f) (hbe : b ≤ e) (hcf : c ≤ f) : a * b + c * d ≤ a * e + f * d :=
begin
    have L1 : a ≤ a,
    linarith,
    have L2 : a *b ≤ a * e, exact mul_le_mul_left1 ha hbe,

    have L3 : d ≤ d, linarith,
    have L4 : c * d ≤ f * d, exact mul_le_mul_right1 hd hcf,
    linarith,

end

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

end

definition is_limit (a : ℕ → ℝ) (α : ℝ) :=
  ∀ ε : ℝ, 0 < ε → ∃ N : ℕ, ∀ n : ℕ, N ≤ n → |a n - α| < ε

definition is_limit' (a : ℕ → ℝ) (α : ℝ) :=
  ∀ ε : ℝ, 0 < ε → ∃ N : ℕ, ∀ n : ℕ, N ≤ n → |a n - α| ≤ ε

lemma lim_le_iff_lim_lt {L : ℝ}{a : ℕ → ℝ} : ((is_limit a L) ↔ (is_limit' a L)):=
begin
split,
intros h ε hε,
have Q := h(ε)(hε),
cases Q with N hN,
use N,
intros n hn,
have R := hN(n)(hn),
linarith,
intros h ε hε,
have hε' : 0 < (ε / 2), by linarith,
have S := h(ε/2)(hε'),
cases S with N hN,
use N,
intros n hn,
have T := hN(n)(hn),
linarith,
end

lemma so_obvious {a b c d: ℝ} (hb : 0 < b) (hc : 0 < c): a * b + c * d < a * b + b + d * c + c :=
begin
 linarith,

end

 lemma lt_imp_le {a b : ℝ} (h : a < b) : a ≤ b :=
 begin
linarith,
 end

 lemma abs_pos_of_ne_zero {a : ℝ} : a ≠ 0 → 0 < |a| :=
 begin
  intro h,
  rw lt_abs,
  simp,
  simp at h,
  tauto,
 end

definition ev_bd_away_from_zero (b : ℕ → ℝ) :=
 ∃ c : ℝ, 0 < c ∧ ∃ N : ℕ, ∀ n : ℕ, N ≤ n → |b n| ≥ c

 lemma lim_nz_ev_bd_away_from_zero (b : ℕ → ℝ) {k : ℝ} (hk: k ≠ 0) : is_limit b k → ev_bd_away_from_zero b :=
 begin
    intro j,
    unfold ev_bd_away_from_zero,

    unfold is_limit at j,
    use |k| /2,
    split,
    have T := abs_pos_of_ne_zero hk,
    linarith,

    have T : 0 < |k|, exact abs_pos_of_ne_zero hk,
    have T1 : 0 < |k| / 2, linarith,
    have Q := (j(|k|/2))(T1),
     cases Q with d hd,
    use d,
    intro n,
    intro y,

    have M := hd(n) y,
    have L : | |b n| - |k| | ≤ |b n - k|, exact abs_abs_sub_abs_le_abs_sub _ _,

    have P : | |b n| - |k| | < |k| / 2, linarith,
    rw abs_lt at P,
    cases P with d hd,
    have O : |k| - |k| / 2 < | b n |, linarith,
    have R : |k| - |k| / 2 = |k| / 2, ring, rw R at O,
    apply lt_imp_le, exact O,
 end

 lemma stuff1 {a b : ℝ} (ha : a ≠ 0) (hb : b ≠ 0) : | ( 1 /a - 1 / b) | = | (b - a) / (a * b) |:=
 begin

  sorry,

 end

 lemma stuff2 {a b : ℝ} (ha : a ≠ 0) (hb : b ≠ 0) :  | (b - a) / ( a * b) | = 1 / (|a| * |b|) * |a - b| :=
 begin
  rcases lt_trichotomy a 0 with han | haz | hap,
  swap,
  contradiction,
  rcases lt_trichotomy b 0 with hbn | hbz | hbp,
  swap,
  contradiction,
  ring_nf, rw mul_inv,
  rw mul_assoc, rw mul_comm (b⁻¹) b,
  simp, rw mul_inv_cancel hb,

  --rw mul_left_comm a⁻¹ b⁻¹ a,
  rw mul_assoc, rw mul_comm (b⁻¹) a,
  rw ← mul_assoc,
  have Bruh : a⁻¹ * 1 - a⁻¹ * a * b⁻¹ = a⁻¹ * 1 - b⁻¹ * a * a⁻¹,
  ring,
  rw Bruh,
  rw mul_assoc,
  rw mul_inv_cancel ha,
  rw mul_one,
  rw mul_one,
  sorry,
  sorry,
  sorry,

 end

 lemma stuff3 {a b : ℝ} (ha : a ≠ 0) (hb : b ≠ 0) (pb : 0 < b) (c : a ≥ b) : 1 / a ≤ 1 / b :=
 begin
  sorry,
 end

lemma stuff4 {a b c : ℝ} (ha : a ≠ 0) (hb : b ≠ 0) (hc : c ≠ 0) (hab : a ≥ b) : 1 / (a * c) ≤ 1 / (b * c) :=
begin
  sorry,
end

lemma stuff5 {a b c : ℝ} (ha : 0 < a) (hb : 0 ≤ b) (hc : 0 < c) (hbc : b < c) :
a * b < a * c :=
begin
  rw mul_lt_mul_left,
  exact hbc,
  exact ha,
end

lemma mul_le_mul_right_plz1 {a b c : ℝ} (h1 : 0 < a) (h2 : b ≤ c) : b * a ≤ c * a :=
begin
    have Q : a ≥ 0, exact lt_imp_le h1,
    have f1 : 0 ≤ c -b, linarith,
have f2 : 0 ≤ a * (c-b), exact mul_nonneg Q f1,
have f3 : 0 ≤ a * c - a * b, linarith,
linarith,

end

lemma soul_sucking_deep_sadness {ε a : ℝ} (h : 0 < ε) (ha : a ≠ 0): (1 / a) * (a * ε) = ε :=
begin
simp, rw ← mul_assoc, rw inv_mul_cancel, linarith, exact ha,
end

lemma bs_lemma {γ d α β ε : ℝ} (ha : 0 < γ) (hb : 0 < d) (hc : 0 < α)(hd : 0 ≤ β)(he : 0 < ε) (gnz : γ ≠ 0) (anz : α ≠ 0) (dnz : d ≠ 0) (h : d ≤ γ) (h' : (1 / (d * α) * β ≤ ε))
: (1 / (γ * α) * β ≤ ε) :=
begin
  have L1 : d * α ≤ γ * α, exact mul_le_mul_right_plz1 hc h,
  have L2 : 1 / (γ * α) ≤ 1 / (d * α), exact stuff4 gnz dnz anz h,
  have L2 : (1 / (γ * α)) * β ≤ (1 / (d * α)) * β, exact mul_le_mul_right1 hd L2,
  linarith,

end


/-
Copyright (c) 2019 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.mv_polynomial.default
import Mathlib.field_theory.finite.basic
import Mathlib.PostPort

universes u_1 u_2 u_3

namespace Mathlib

/-!
# The Chevalley–Warning theorem

This file contains a proof of the Chevalley–Warning theorem.
Throughout most of this file, `K` denotes a finite field
and `q` is notation for the cardinality of `K`.

## Main results

1. Let `f` be a multivariate polynomial in finitely many variables (`X s`, `s : σ`)
   such that the total degree of `f` is less than `(q-1)` times the cardinality of `σ`.
   Then the evaluation of `f` on all points of `σ → K` (aka `K^σ`) sums to `0`.
   (`sum_mv_polynomial_eq_zero`)
2. The Chevalley–Warning theorem (`char_dvd_card_solutions`).
   Let `f i` be a finite family of multivariate polynomials
   in finitely many variables (`X s`, `s : σ`) such that
   the sum of the total degrees of the `f i` is less than the cardinality of `σ`.
   Then the number of common solutions of the `f i`
   is divisible by the characteristic of `K`.

## Notation

- `K` is a finite field
- `q` is notation for the cardinality of `K`
- `σ` is the indexing type for the variables of a multivariate polynomial ring over `K`

-/

theorem mv_polynomial.sum_mv_polynomial_eq_zero {K : Type u_1} {σ : Type u_2} [fintype K] [field K] [fintype σ] [DecidableEq σ] (f : mv_polynomial σ K) (h : mv_polynomial.total_degree f < (fintype.card K - 1) * fintype.card σ) : (finset.sum finset.univ fun (x : σ → K) => coe_fn (mv_polynomial.eval x) f) = 0 := sorry

/-- The Chevalley–Warning theorem.
Let `(f i)` be a finite family of multivariate polynomials
in finitely many variables (`X s`, `s : σ`) over a finite field of characteristic `p`.
Assume that the sum of the total degrees of the `f i` is less than the cardinality of `σ`.
Then the number of common solutions of the `f i` is divisible by `p`. -/
theorem char_dvd_card_solutions_family {K : Type u_1} {σ : Type u_2} [fintype K] [field K] [fintype σ] [DecidableEq K] [DecidableEq σ] (p : ℕ) [char_p K p] {ι : Type u_3} {s : finset ι} {f : ι → mv_polynomial σ K} (h : (finset.sum s fun (i : ι) => mv_polynomial.total_degree (f i)) < fintype.card σ) : p ∣ fintype.card (Subtype fun (x : σ → K) => ∀ (i : ι), i ∈ s → coe_fn (mv_polynomial.eval x) (f i) = 0) := sorry

/-- The Chevalley–Warning theorem.
Let `f` be a multivariate polynomial in finitely many variables (`X s`, `s : σ`)
over a finite field of characteristic `p`.
Assume that the total degree of `f` is less than the cardinality of `σ`.
Then the number of solutions of `f` is divisible by `p`.
See `char_dvd_card_solutions_family` for a version that takes a family of polynomials `f i`. -/
theorem char_dvd_card_solutions {K : Type u_1} {σ : Type u_2} [fintype K] [field K] [fintype σ] [DecidableEq K] [DecidableEq σ] (p : ℕ) [char_p K p] {f : mv_polynomial σ K} (h : mv_polynomial.total_degree f < fintype.card σ) : p ∣ fintype.card (Subtype fun (x : σ → K) => coe_fn (mv_polynomial.eval x) f = 0) := sorry


import M4R.Set.Basic

namespace M4R
  namespace Zorn

    open Classical

    variable (r : α → α → Prop)
    local infix:50 " ≤ " => r

    def Chain (c : Set α) := ∀ x ∈ c, ∀ y ∈ c, x ≠ y → r x y ∨ r y x

    theorem chain_insert {c : Set α} {a : α} (hc : Chain r c) (ha : ∀ b ∈ c, b ≠ a → a ≤ b ∨ b ≤ a) :
      Chain r (c.insert a) := by
        intro x hx y hy hxy
        cases hx with
        | inl hx =>
          rw [hx] at hxy; rw [hx]
          exact ha y (hy.resolve_left hxy.symm) hxy.symm
        | inr hx =>
          cases hy with
          | inl hy =>
            rw [hy] at hxy; rw [hy]
            exact (ha x hx hxy).comm
          | inr hy =>
            exact hc x hx y hy hxy

    /-- `super_chain c₁ c₂` means that `c₂ is a chain that strictly includes `c₁`. -/
    def super_chain (c₁ c₂ : Set α) : Prop := Chain r c₂ ∧ c₁ ⊊ c₂

    /-- A chain `c` is a maximal chain if there does not exists a chain strictly including `c`. -/
    def is_max_chain (c : Set α) := Chain r c ∧ ¬ (∃ c', super_chain r c c')

    /-- Given a set `c`, if there exists a chain `c'` strictly including `c`, then `succ_chain c`
    is one of these chains. Otherwise it is `c`. -/
    def succ_chain (c : Set α) : Set α :=
      if h : ∃ c' : Set α, Chain r c ∧ super_chain r c c' then
        choose h
      else c

    theorem succ_spec {c : Set α} (h : ∃ c', Chain r c ∧ super_chain r c c') :
      super_chain r c (succ_chain r c) := by
        have ⟨_, h'⟩: Chain r c ∧ super_chain r c (choose h) := by
          exact @choose_spec _ (fun c' => Chain r c ∧ super_chain r c c') _
        simp only [succ_chain, dif_pos h, h']

    theorem chain_succ {c : Set α} (hc : Chain r c) : Chain r (succ_chain r c) :=
      if h : ∃c', Chain r c ∧ super_chain r c c' then
        (succ_spec r h).left
      else
        by simp only [succ_chain, dif_neg h]; exact hc

    theorem super_of_not_max {c : Set α} (hc₁ : Chain r c) (hc₂ : ¬ is_max_chain r c) :
      super_chain r c (succ_chain r c) := by
        simp only [is_max_chain, not_and_iff_or_not, iff_not_not] at hc₂
        exact Or.elim hc₂ (fun _ => by contradiction) (fun ⟨c', hc'⟩ => succ_spec r ⟨c', hc₁, hc'⟩)

    theorem succ_increasing {c : Set α} : c ⊆ succ_chain r c :=
      if h : ∃c', Chain r c ∧ super_chain r c c' then
        (succ_spec r h).right.left
      else
        by simp only [succ_chain, dif_neg h, Subset.refl]

    /-- Set of sets reachable from `∅` using `succ_chain` and `⋃₀`. -/
    inductive chain_closure : Set α → Prop
    | succ : ∀ {s}, chain_closure s → chain_closure (succ_chain r s)
    | union : ∀ {s}, (∀ a ∈ s, chain_closure a) → chain_closure (⋃₀ s)

    theorem chain_closure_closure : chain_closure r (⋃₀ chain_closure r) :=
      chain_closure.union (fun _ => id)

    private theorem chain_closure_succ_total_aux (hc₁ : chain_closure r c₁) (hc₂ : chain_closure r c₂)
      (h : ∀{c₃}, chain_closure r c₃ → c₃ ⊆ c₂ → c₂ = c₃ ∨ succ_chain r c₃ ⊆ c₂) : c₁ ⊆ c₂ ∨ succ_chain r c₂ ⊆ c₁ := by
        induction hc₁
        case succ c₃ hc₃ ih =>
          cases ih with
          | inl ih =>
            cases h hc₃ ih with
            | inl h => rw [h]; exact Or.inr (Subset.refl _)
            | inr h => exact Or.inl h
          | inr ih => exact Or.inr (Subset.trans ih (succ_increasing r))
        case union s hs ih =>
          exact or_iff_not_imp_right.mpr (fun hn =>
            Set.SoSUnion.subset (fun a ha =>
              (ih a ha).resolve_right (mt (fun h =>
                Subset.trans h (Set.SoSUnion.subset_of_mem ha)) hn)))

    private theorem chain_closure_succ_total (hc₁ : chain_closure r c₁) (hc₂ : chain_closure r c₂) (h : c₁ ⊆ c₂) :
      c₂ = c₁ ∨ succ_chain r c₁ ⊆ c₂ := by
        induction hc₂ generalizing c₁ hc₁;
        case succ c₂ hc₂ ih =>
          have : c₁ ⊆ c₂ ∨ succ_chain r c₂ ⊆ c₁ := chain_closure_succ_total_aux r hc₁ hc₂ ih
          cases this with
          | inl h₁ =>
            cases (ih hc₁ h₁) with
            | inl h₂ => rw [h₂]; exact Or.inr (Subset.refl _)
            | inr h₂ => exact Or.inr (Subset.trans h₂ (succ_increasing r))
          | inr h₁ => exact (Or.inl (Set.subset.antisymm h₁ h))
        case union s hs ih =>
          apply Or.imp_left (fun h' => Set.subset.antisymm h' h)
          apply byContradiction
          simp [not_or_iff_and_not, Set.SoSUnion.subset_iff, not_forall, and_imp]
          intro c₃ hc₃ h₁ h₂
          have := chain_closure_succ_total_aux r hc₁ (hs c₃ hc₃) (ih _ hc₃)
          cases this with
          | inl h =>
            cases ih c₃ hc₃ hc₁ h with
            | inl h' => apply h₁; rw [h']; exact Subset.refl _
            | inr h' => exact h₂ (Subset.trans h' (Set.SoSUnion.subset_of_mem hc₃))
          | inr h => exact h₁ (Subset.trans (succ_increasing r) h)

    theorem chain_closure_total (hc₁ : chain_closure r c₁) (hc₂ : chain_closure r c₂) : c₁ ⊆ c₂ ∨ c₂ ⊆ c₁ :=
      Or.imp_right (Subset.trans (succ_increasing r))
        (chain_closure_succ_total_aux r hc₁ hc₂ (fun hc₃ => chain_closure_succ_total r hc₃ hc₂))

    theorem chain_closure_succ_fixpoint (hc₁ : chain_closure r c₁) (hc₂ : chain_closure r c₂)
      (h_eq : succ_chain r c₂ = c₂) : c₁ ⊆ c₂ := by
        induction hc₁
        case succ c₁ hc₁ ih =>
          exact Or.elim (chain_closure_succ_total r hc₁ hc₂ ih)
            (fun h => by rw [←h, h_eq]; exact Subset.refl _) id
        case union s hs ih =>
          exact Set.SoSUnion.subset (fun c₁ hc₁ => ih c₁ hc₁)

    theorem chain_closure_succ_fixpoint_iff (hc : chain_closure r c) :
      succ_chain r c = c ↔ c = ⋃₀ chain_closure r :=
        ⟨fun h => Set.subset.antisymm
          (Set.SoSUnion.subset_of_mem hc)
          (chain_closure_succ_fixpoint r (chain_closure_closure r) hc h),
        fun (h : c = ⋃₀ {c : Set α | chain_closure r c}) => Set.subset.antisymm
          (by conv => rhs; rw [h]; exact Set.SoSUnion.subset_of_mem (chain_closure.succ hc))
          (succ_increasing r)⟩

    theorem chain_chain_closure (hc : chain_closure r c) : Chain r c := by
      induction hc
      case succ c hc ih => exact chain_succ r ih
      case union s hs ih =>
        exact fun c₁ ⟨t₁, ht₁, (hc₁ : c₁ ∈ t₁)⟩ c₂ ⟨t₂, ht₂, (hc₂ : c₂ ∈ t₂)⟩ hneq =>
          have : t₁ ⊆ t₂ ∨ t₂ ⊆ t₁ := chain_closure_total r (hs _ ht₁) (hs _ ht₂)
          Or.elim this
            (fun (h : t₁ ⊆ t₂) => ih t₂ ht₂ c₁ (h hc₁) c₂ hc₂ hneq)
            (fun (h : t₂ ⊆ t₁) => ih t₁ ht₁ c₁ hc₁ c₂ (h hc₂) hneq)

    /-- `max_chain` is the union of all sets in the chain closure. -/
    def max_chain : Set α := ⋃₀ chain_closure r

    /-- Hausdorff's maximality principle
    There exists a maximal totally ordered subset of `α`.
    Note that we do not require `α` to be partially ordered by `r`. -/
    theorem max_chain_spec : is_max_chain r (max_chain r) :=
      byContradiction fun h =>
        have ⟨_, h₁⟩ : super_chain r (⋃₀ chain_closure r) (succ_chain r (⋃₀ chain_closure r)) :=
          super_of_not_max r (chain_chain_closure r (chain_closure_closure r)) h
        have h₂ : succ_chain r (⋃₀ chain_closure r) = (⋃₀ chain_closure r) :=
          (chain_closure_succ_fixpoint_iff r (chain_closure_closure r)).mpr rfl
        Set.subset.proper_neq h₁ h₂.symm

    /-- Zorn's lemma
    If every chain has an upper bound, then there is a maximal element -/
    theorem exists_maximal_of_chains_bounded (h : ∀ c : Set α, Chain r c → ∃ ub : α, ∀ a ∈ c, a ≤ ub)
      (trans : ∀ {a b c : α}, a ≤ b → b ≤ c → a ≤ c) : ∃ m : α, ∀ a : α, m ≤ a → a ≤ m :=
        have ⟨ub, hub⟩ : ∃ ub : α, ∀ a ∈ max_chain r, a ≤ ub := h _ (max_chain_spec r).left
        ⟨ub, fun a ha =>
          have : Chain r ((max_chain r).insert a) :=
            chain_insert r (max_chain_spec r).left (fun b hb _ => Or.inr (trans (hub b hb) ha))
          have : a ∈ (max_chain r) :=
            byContradiction (fun h : a ∉ (max_chain r) =>
            (max_chain_spec r).right ⟨(max_chain r).insert a, this, Set.subset.insert_neq h⟩)
          hub a this⟩

    theorem lemma_eq (h : ∀ c : Set α, Chain r c → ∃ ub : α, ∀ a ∈ c, a ≤ ub)
      (trans : ∀ {a b c : α}, a ≤ b → b ≤ c → a ≤ c) (antisymm : ∀ {a b : α}, a ≤ b → b ≤ a → a = b) :
        ∃ m : α, ∀ a : α, m ≤ a → a = m :=
          let ⟨m, hm⟩ := exists_maximal_of_chains_bounded r h trans
          ⟨m, fun a ha => antisymm (hm a ha) ha⟩

    theorem lemma_subset (h : ∀ c : Set (Set α), Chain Subset.subset c → ∃ ub : Set α, ∀ a ∈ c, a ⊆ ub) :
      ∃ m : Set α, ∀ a : Set α, m ⊆ a → a = m := lemma_eq Subset.subset h Subset.trans Set.subset.antisymm

  end Zorn
end M4R


/-
Copyright (c) 2018 Patrick Massot. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Patrick Massot, Kevin Buzzard, Scott Morrison, Johan Commelin, Chris Hughes,
  Johannes Hölzl, Yury Kudryashov
-/

import algebra.group_power.basic

/-!
# Instances on spaces of monoid and group morphisms

We endow the space of monoid morphisms `M →* N` with a `comm_monoid` structure when the target is
commutative, through pointwise multiplication, and with a `comm_group` structure when the target
is a commutative group. We also prove the same instances for additive situations.

Since these structures permit morphisms of morphisms, we also provide some composition-like
operations.
-/

universes uM uN uP uQ
variables {M : Type uM} {N : Type uN} {P : Type uP} {Q : Type uQ}

lemma nat.succ_eq_one_add (n : ℕ) : n.succ = 1 + n :=
by rw [nat.succ_eq_add_one, nat.add_comm]

/-- `(M →* N)` is a `comm_monoid` if `N` is commutative. -/
instance [mul_one_class M] [comm_monoid N] : comm_monoid (M →* N) :=
{ mul := (*),
  mul_assoc := by intros; ext; apply mul_assoc,
  one := 1,
  one_mul := by intros; ext; apply one_mul,
  mul_one := by intros; ext; apply mul_one,
  mul_comm := by intros; ext; apply mul_comm,
  npow := λ n f,
  { to_fun := λ x, npow n (f x),
    map_one' := by simp,
    map_mul' := λ x y, by simp [mul_pow] },
  npow_zero' := λ f, by { ext x, simp },
  npow_succ' := λ n f, by { ext x, simp [pow_succ] } }

/-- `(M →+ N)` is an `add_comm_monoid` if `N` is commutative. -/
instance [add_zero_class M] [add_comm_monoid N] : add_comm_monoid (M →+ N) :=
{ add := (+),
  add_assoc := by intros; ext; apply add_assoc,
  zero := 0,
  zero_add := by intros; ext; apply zero_add,
  add_zero := by intros; ext; apply add_zero,
  add_comm := by intros; ext; apply add_comm,
  nsmul := λ n f,
  { to_fun := λ x, nsmul n (f x),
    map_zero' := by simp [nsmul_zero],
    map_add' := λ x y, by simp [nsmul_add] },
  nsmul_zero' := λ f, by { ext x, simp [zero_nsmul], },
  nsmul_succ' := λ n f, by { ext x, simp [nat.succ_eq_one_add, add_nsmul] } }

attribute [to_additive] monoid_hom.comm_monoid

/-- If `G` is a commutative group, then `M →* G` is a commutative group too. -/
instance {M G} [mul_one_class M] [comm_group G] : comm_group (M →* G) :=
{ inv := has_inv.inv,
  div := has_div.div,
  div_eq_mul_inv := by { intros, ext, apply div_eq_mul_inv },
  mul_left_inv := by intros; ext; apply mul_left_inv,
  gpow := λ n f, { to_fun := λ x, gpow n (f x),
    map_one' := by simp,
    map_mul' := λ x y, by simp [mul_gpow] },
  gpow_zero' := λ f, by { ext x, simp },
  gpow_succ' := λ n f, by { ext x, simp [gpow_of_nat, pow_succ] },
  gpow_neg'  := λ n f, by { ext x, simp },
  ..monoid_hom.comm_monoid }

/-- If `G` is an additive commutative group, then `M →+ G` is an additive commutative group too. -/
instance {M G} [add_zero_class M] [add_comm_group G] : add_comm_group (M →+ G) :=
{ neg := has_neg.neg,
  sub := has_sub.sub,
  sub_eq_add_neg := by { intros, ext, apply sub_eq_add_neg },
  add_left_neg := by intros; ext; apply add_left_neg,
  gsmul := λ n f, { to_fun := λ x, gsmul n (f x),
    map_zero' := by simp,
    map_add' := λ x y, by simp [gsmul_add] },
  gsmul_zero' := λ f, by { ext x, simp },
  gsmul_succ' := λ n f, by { ext x, simp [gsmul_of_nat, nat.succ_eq_one_add, add_nsmul] },
  gsmul_neg'  := λ n f, by { ext x, simp },
  ..add_monoid_hom.add_comm_monoid }

attribute [to_additive] monoid_hom.comm_group

/-!
### Morphisms of morphisms

The structures above permit morphisms that themselves produce morphisms, provided the codomain
is commutative.
-/

namespace monoid_hom

@[to_additive]
lemma ext_iff₂ {mM : mul_one_class M} {mN : mul_one_class N} {mP : comm_monoid P}
  {f g : M →* N →* P} :
  f = g ↔ (∀ x y, f x y = g x y) :=
monoid_hom.ext_iff.trans $ forall_congr $ λ _, monoid_hom.ext_iff

/-- `flip` arguments of `f : M →* N →* P` -/
@[to_additive "`flip` arguments of `f : M →+ N →+ P`"]
def flip {mM : mul_one_class M} {mN : mul_one_class N} {mP : comm_monoid P} (f : M →* N →* P) :
  N →* M →* P :=
{ to_fun := λ y, ⟨λ x, f x y, by rw [f.map_one, one_apply], λ x₁ x₂, by rw [f.map_mul, mul_apply]⟩,
  map_one' := ext $ λ x, (f x).map_one,
  map_mul' := λ y₁ y₂, ext $ λ x, (f x).map_mul y₁ y₂ }

@[simp, to_additive] lemma flip_apply
  {mM : mul_one_class M} {mN : mul_one_class N} {mP : comm_monoid P}
  (f : M →* N →* P) (x : M) (y : N) :
  f.flip y x = f x y :=
rfl

/-- Evaluation of a `monoid_hom` at a point as a monoid homomorphism. See also `monoid_hom.apply`
for the evaluation of any function at a point. -/
@[to_additive "Evaluation of an `add_monoid_hom` at a point as an additive monoid homomorphism.
See also `add_monoid_hom.apply` for the evaluation of any function at a point.", simps]
def eval [mul_one_class M] [comm_monoid N] : M →* (M →* N) →* N := (monoid_hom.id (M →* N)).flip

/-- The expression `λ g m, g (f m)` as a `monoid_hom`.
Equivalently, `(λ g, monoid_hom.comp g f)` as a `monoid_hom`. -/
@[to_additive "The expression `λ g m, g (f m)` as a `add_monoid_hom`.
Equivalently, `(λ g, monoid_hom.comp g f)` as a `add_monoid_hom`.

This also exists in a `linear_map` version, `linear_map.lcomp`.", simps]
def comp_hom' [mul_one_class M] [mul_one_class N] [comm_monoid P] (f : M →* N) :
  (N →* P) →* M →* P :=
flip $ eval.comp f

/-- Composition of monoid morphisms (`monoid_hom.comp`) as a monoid morphism.

Note that unlike `monoid_hom.comp_hom'` this requires commutativity of `N`. -/
@[to_additive "Composition of additive monoid morphisms (`add_monoid_hom.comp`) as an additive
monoid morphism.

Note that unlike `add_monoid_hom.comp_hom'` this requires commutativity of `N`.

This also exists in a `linear_map` version, `linear_map.llcomp`.", simps]
def comp_hom [mul_one_class M] [comm_monoid N] [comm_monoid P] :
  (N →* P) →* (M →* N) →* (M →* P) :=
{ to_fun := λ g, { to_fun := g.comp, map_one' := comp_one g, map_mul' := comp_mul g },
  map_one' := by { ext1 f, exact one_comp f },
  map_mul' := λ g₁ g₂, by { ext1 f, exact mul_comp g₁ g₂ f } }

/-- Flipping arguments of monoid morphisms (`monoid_hom.flip`) as a monoid morphism. -/
@[to_additive "Flipping arguments of additive monoid morphisms (`add_monoid_hom.flip`)
as an additive monoid morphism.", simps]
def flip_hom {mM : mul_one_class M} {mN : mul_one_class N} {mP : comm_monoid P}
  : (M →* N →* P) →* (N →* M →* P) :=
{ to_fun := monoid_hom.flip, map_one' := rfl, map_mul' := λ f g, rfl }

/-- The expression `λ m q, f m (g q)` as a `monoid_hom`.

Note that the expression `λ q n, f (g q) n` is simply `monoid_hom.comp`. -/
@[to_additive "The expression `λ m q, f m (g q)` as an `add_monoid_hom`.

Note that the expression `λ q n, f (g q) n` is simply `add_monoid_hom.comp`.

This also exists as a `linear_map` version, `linear_map.compl₂`"]
def compl₂ [mul_one_class M] [mul_one_class N] [comm_monoid P] [comm_monoid Q]
  (f : M →* N →* P) (g : Q →* N) : M →* Q →* P :=
(comp_hom' g).comp f

@[simp, to_additive]
lemma compl₂_apply [mul_one_class M] [mul_one_class N] [comm_monoid P] [comm_monoid Q]
  (f : M →* N →* P) (g : Q →* N) (m : M) (q : Q) :
  (compl₂ f g) m q = f m (g q) := rfl

/-- The expression `λ m n, g (f m n)` as a `monoid_hom`. -/
@[to_additive "The expression `λ m n, g (f m n)` as an `add_monoid_hom`.

This also exists as a linear_map version, `linear_map.compr₂`"]
def compr₂ [mul_one_class M] [mul_one_class N] [comm_monoid P] [comm_monoid Q]
  (f : M →* N →* P) (g : P →* Q) : M →* N →* Q :=
(comp_hom g).comp f

@[simp, to_additive]
lemma compr₂_apply [mul_one_class M] [mul_one_class N] [comm_monoid P] [comm_monoid Q]
  (f : M →* N →* P) (g : P →* Q) (m : M) (n : N) :
  (compr₂ f g) m n = g (f m n) := rfl

end monoid_hom

/-!
### Miscellaneous definitions

Due to the fact this file imports `algebra.group_power.basic`, it is not possible to import it in
some of the lower-level files like `algebra.ring.basic`. The following lemmas should be rehomed
if the import structure permits them to be.
-/

section semiring

variables {R S : Type*} [semiring R] [semiring S]

/-- Multiplication of an element of a (semi)ring is an `add_monoid_hom` in both arguments.

This is a more-strongly bundled version of `add_monoid_hom.mul_left` and `add_monoid_hom.mul_right`.

A stronger version of this exists for algebras as `algebra.lmul`.
-/
def add_monoid_hom.mul : R →+ R →+ R :=
{ to_fun := add_monoid_hom.mul_left,
  map_zero' := add_monoid_hom.ext $ zero_mul,
  map_add' := λ a b, add_monoid_hom.ext $ add_mul a b }

lemma add_monoid_hom.mul_apply (x y : R) : add_monoid_hom.mul x y = x * y := rfl

@[simp]
lemma add_monoid_hom.coe_mul :
  ⇑(add_monoid_hom.mul : R →+ R →+ R) = add_monoid_hom.mul_left := rfl

@[simp]
lemma add_monoid_hom.coe_flip_mul :
  ⇑(add_monoid_hom.mul : R →+ R →+ R).flip = add_monoid_hom.mul_right := rfl

/-- An `add_monoid_hom` preserves multiplication if pre- and post- composition with
`add_monoid_hom.mul` are equivalent. By converting the statement into an equality of
`add_monoid_hom`s, this lemma allows various specialized `ext` lemmas about `→+` to then be applied.
-/
lemma add_monoid_hom.map_mul_iff (f : R →+ S) :
  (∀ x y, f (x * y) = f x * f y) ↔
    (add_monoid_hom.mul : R →+ R →+ R).compr₂ f = (add_monoid_hom.mul.comp f).compl₂ f :=
iff.symm add_monoid_hom.ext_iff₂

end semiring


/-
Copyright (c) 2021 David Wärn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: David Wärn

! This file was ported from Lean 3 source module topology.algebra.semigroup
! leanprover-community/mathlib commit 34ee86e6a59d911a8e4f89b68793ee7577ae79c7
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Topology.Separation

/-!
# Idempotents in topological semigroups

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

This file provides a sufficient condition for a semigroup `M` to contain an idempotent (i.e. an
element `m` such that `m * m = m `), namely that `M` is a nonempty compact Hausdorff space where
right-multiplication by constants is continuous.

We also state a corresponding lemma guaranteeing that a subset of `M` contains an idempotent.
-/

/- warning: exists_idempotent_of_compact_t2_of_continuous_mul_left -> exists_idempotent_of_compact_t2_of_continuous_mul_left is a dubious translation:
lean 3 declaration is
  forall {M : Type.{u1}} [_inst_1 : Nonempty.{succ u1} M] [_inst_2 : Semigroup.{u1} M] [_inst_3 : TopologicalSpace.{u1} M] [_inst_4 : CompactSpace.{u1} M _inst_3] [_inst_5 : T2Space.{u1} M _inst_3], (forall (r : M), Continuous.{u1, u1} M M _inst_3 _inst_3 (fun (_x : M) => HMul.hMul.{u1, u1, u1} M M M (instHMul.{u1} M (Semigroup.toHasMul.{u1} M _inst_2)) _x r)) -> (Exists.{succ u1} M (fun (m : M) => Eq.{succ u1} M (HMul.hMul.{u1, u1, u1} M M M (instHMul.{u1} M (Semigroup.toHasMul.{u1} M _inst_2)) m m) m))
but is expected to have type
  forall {M : Type.{u1}} [_inst_1 : Nonempty.{succ u1} M] [_inst_2 : Semigroup.{u1} M] [_inst_3 : TopologicalSpace.{u1} M] [_inst_4 : CompactSpace.{u1} M _inst_3] [_inst_5 : T2Space.{u1} M _inst_3], (forall (r : M), Continuous.{u1, u1} M M _inst_3 _inst_3 (fun (_x : M) => HMul.hMul.{u1, u1, u1} M M M (instHMul.{u1} M (Semigroup.toMul.{u1} M _inst_2)) _x r)) -> (Exists.{succ u1} M (fun (m : M) => Eq.{succ u1} M (HMul.hMul.{u1, u1, u1} M M M (instHMul.{u1} M (Semigroup.toMul.{u1} M _inst_2)) m m) m))
Case conversion may be inaccurate. Consider using '#align exists_idempotent_of_compact_t2_of_continuous_mul_left exists_idempotent_of_compact_t2_of_continuous_mul_leftₓ'. -/
/- ./././Mathport/Syntax/Translate/Basic.lean:635:2: warning: expanding binder collection (m m' «expr ∈ » N) -/
/-- Any nonempty compact Hausdorff semigroup where right-multiplication is continuous contains
an idempotent, i.e. an `m` such that `m * m = m`. -/
@[to_additive
      "Any nonempty compact Hausdorff additive semigroup where right-addition is continuous\ncontains an idempotent, i.e. an `m` such that `m + m = m`"]
theorem exists_idempotent_of_compact_t2_of_continuous_mul_left {M} [Nonempty M] [Semigroup M]
    [TopologicalSpace M] [CompactSpace M] [T2Space M]
    (continuous_mul_left : ∀ r : M, Continuous (· * r)) : ∃ m : M, m * m = m :=
  by
  /- We apply Zorn's lemma to the poset of nonempty closed subsemigroups of `M`. It will turn out that
  any minimal element is `{m}` for an idempotent `m : M`. -/
  let S : Set (Set M) :=
    { N | IsClosed N ∧ N.Nonempty ∧ ∀ (m) (_ : m ∈ N) (m') (_ : m' ∈ N), m * m' ∈ N }
  rsuffices ⟨N, ⟨N_closed, ⟨m, hm⟩, N_mul⟩, N_minimal⟩ : ∃ N ∈ S, ∀ N' ∈ S, N' ⊆ N → N' = N
  · use m
    /- We now have an element `m : M` of a minimal subsemigroup `N`, and want to show `m + m = m`.
    We first show that every element of `N` is of the form `m' + m`.-/
    have scaling_eq_self : (· * m) '' N = N :=
      by
      apply N_minimal
      · refine' ⟨(continuous_mul_left m).IsClosedMap _ N_closed, ⟨_, ⟨m, hm, rfl⟩⟩, _⟩
        rintro _ ⟨m'', hm'', rfl⟩ _ ⟨m', hm', rfl⟩
        refine' ⟨m'' * m * m', N_mul _ (N_mul _ hm'' _ hm) _ hm', mul_assoc _ _ _⟩
      · rintro _ ⟨m', hm', rfl⟩
        exact N_mul _ hm' _ hm
    /- In particular, this means that `m' * m = m` for some `m'`. We now use minimality again to show
    that this holds for all `m' ∈ N`. -/
    have absorbing_eq_self : N ∩ { m' | m' * m = m } = N :=
      by
      apply N_minimal
      · refine' ⟨N_closed.inter ((T1Space.t1 m).Preimage (continuous_mul_left m)), _, _⟩
        · rwa [← scaling_eq_self] at hm
        · rintro m'' ⟨mem'', eq'' : _ = m⟩ m' ⟨mem', eq' : _ = m⟩
          refine' ⟨N_mul _ mem'' _ mem', _⟩
          rw [Set.mem_setOf_eq, mul_assoc, eq', eq'']
      apply Set.inter_subset_left
    -- Thus `m * m = m` as desired.
    rw [← absorbing_eq_self] at hm
    exact hm.2
  refine' zorn_superset _ fun c hcs hc => _
  refine'
    ⟨⋂₀ c, ⟨isClosed_interₛ fun t ht => (hcs ht).1, _, fun m hm m' hm' => _⟩, fun s hs =>
      Set.interₛ_subset_of_mem hs⟩
  · obtain rfl | hcnemp := c.eq_empty_or_nonempty
    · rw [Set.interₛ_empty]
      apply Set.univ_nonempty
    convert@IsCompact.nonempty_interᵢ_of_directed_nonempty_compact_closed _ _ _ hcnemp.coe_sort
        (coe : c → Set M) _ _ _ _
    · simp only [Subtype.range_coe_subtype, Set.setOf_mem_eq]
    · refine' DirectedOn.directed_val (IsChain.directedOn hc.symm)
    exacts[fun i => (hcs i.Prop).2.1, fun i => (hcs i.Prop).1.IsCompact, fun i => (hcs i.Prop).1]
  · rw [Set.mem_interₛ]
    exact fun t ht => (hcs ht).2.2 m (set.mem_sInter.mp hm t ht) m' (set.mem_sInter.mp hm' t ht)
#align exists_idempotent_of_compact_t2_of_continuous_mul_left exists_idempotent_of_compact_t2_of_continuous_mul_left
#align exists_idempotent_of_compact_t2_of_continuous_add_left exists_idempotent_of_compact_t2_of_continuous_add_left

/- warning: exists_idempotent_in_compact_subsemigroup -> exists_idempotent_in_compact_subsemigroup is a dubious translation:
lean 3 declaration is
  forall {M : Type.{u1}} [_inst_1 : Semigroup.{u1} M] [_inst_2 : TopologicalSpace.{u1} M] [_inst_3 : T2Space.{u1} M _inst_2], (forall (r : M), Continuous.{u1, u1} M M _inst_2 _inst_2 (fun (_x : M) => HMul.hMul.{u1, u1, u1} M M M (instHMul.{u1} M (Semigroup.toHasMul.{u1} M _inst_1)) _x r)) -> (forall (s : Set.{u1} M), (Set.Nonempty.{u1} M s) -> (IsCompact.{u1} M _inst_2 s) -> (forall (x : M), (Membership.Mem.{u1, u1} M (Set.{u1} M) (Set.hasMem.{u1} M) x s) -> (forall (y : M), (Membership.Mem.{u1, u1} M (Set.{u1} M) (Set.hasMem.{u1} M) y s) -> (Membership.Mem.{u1, u1} M (Set.{u1} M) (Set.hasMem.{u1} M) (HMul.hMul.{u1, u1, u1} M M M (instHMul.{u1} M (Semigroup.toHasMul.{u1} M _inst_1)) x y) s))) -> (Exists.{succ u1} M (fun (m : M) => Exists.{0} (Membership.Mem.{u1, u1} M (Set.{u1} M) (Set.hasMem.{u1} M) m s) (fun (H : Membership.Mem.{u1, u1} M (Set.{u1} M) (Set.hasMem.{u1} M) m s) => Eq.{succ u1} M (HMul.hMul.{u1, u1, u1} M M M (instHMul.{u1} M (Semigroup.toHasMul.{u1} M _inst_1)) m m) m))))
but is expected to have type
  forall {M : Type.{u1}} [_inst_1 : Semigroup.{u1} M] [_inst_2 : TopologicalSpace.{u1} M] [_inst_3 : T2Space.{u1} M _inst_2], (forall (r : M), Continuous.{u1, u1} M M _inst_2 _inst_2 (fun (_x : M) => HMul.hMul.{u1, u1, u1} M M M (instHMul.{u1} M (Semigroup.toMul.{u1} M _inst_1)) _x r)) -> (forall (s : Set.{u1} M), (Set.Nonempty.{u1} M s) -> (IsCompact.{u1} M _inst_2 s) -> (forall (x : M), (Membership.mem.{u1, u1} M (Set.{u1} M) (Set.instMembershipSet.{u1} M) x s) -> (forall (y : M), (Membership.mem.{u1, u1} M (Set.{u1} M) (Set.instMembershipSet.{u1} M) y s) -> (Membership.mem.{u1, u1} M (Set.{u1} M) (Set.instMembershipSet.{u1} M) (HMul.hMul.{u1, u1, u1} M M M (instHMul.{u1} M (Semigroup.toMul.{u1} M _inst_1)) x y) s))) -> (Exists.{succ u1} M (fun (m : M) => And (Membership.mem.{u1, u1} M (Set.{u1} M) (Set.instMembershipSet.{u1} M) m s) (Eq.{succ u1} M (HMul.hMul.{u1, u1, u1} M M M (instHMul.{u1} M (Semigroup.toMul.{u1} M _inst_1)) m m) m))))
Case conversion may be inaccurate. Consider using '#align exists_idempotent_in_compact_subsemigroup exists_idempotent_in_compact_subsemigroupₓ'. -/
/- ./././Mathport/Syntax/Translate/Basic.lean:635:2: warning: expanding binder collection (x y «expr ∈ » s) -/
/-- A version of `exists_idempotent_of_compact_t2_of_continuous_mul_left` where the idempotent lies
in some specified nonempty compact subsemigroup. -/
@[to_additive exists_idempotent_in_compact_add_subsemigroup
      "A version of\n`exists_idempotent_of_compact_t2_of_continuous_add_left` where the idempotent lies in some specified\nnonempty compact additive subsemigroup."]
theorem exists_idempotent_in_compact_subsemigroup {M} [Semigroup M] [TopologicalSpace M] [T2Space M]
    (continuous_mul_left : ∀ r : M, Continuous (· * r)) (s : Set M) (snemp : s.Nonempty)
    (s_compact : IsCompact s) (s_add : ∀ (x) (_ : x ∈ s) (y) (_ : y ∈ s), x * y ∈ s) :
    ∃ m ∈ s, m * m = m := by
  let M' := { m // m ∈ s }
  letI : Semigroup M' :=
    { mul := fun p q => ⟨p.1 * q.1, s_add _ p.2 _ q.2⟩
      mul_assoc := fun p q r => Subtype.eq (mul_assoc _ _ _) }
  haveI : CompactSpace M' := is_compact_iff_compact_space.mp s_compact
  haveI : Nonempty M' := nonempty_subtype.mpr snemp
  have : ∀ p : M', Continuous (· * p) := fun p =>
    ((continuous_mul_left p.1).comp continuous_subtype_val).subtype_mk _
  obtain ⟨⟨m, hm⟩, idem⟩ := exists_idempotent_of_compact_t2_of_continuous_mul_left this
  exact ⟨m, hm, subtype.ext_iff.mp idem⟩
#align exists_idempotent_in_compact_subsemigroup exists_idempotent_in_compact_subsemigroup
#align exists_idempotent_in_compact_add_subsemigroup exists_idempotent_in_compact_add_subsemigroup


/-
Copyright (c) 2014 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro

! This file was ported from Lean 3 source module data.nat.cast.basic
! leanprover-community/mathlib commit acebd8d49928f6ed8920e502a6c90674e75bd441
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.CharZero.Defs
import Mathlib.Algebra.GroupWithZero.Commute
import Mathlib.Algebra.Hom.Ring
import Mathlib.Algebra.Order.Group.Abs
import Mathlib.Algebra.Ring.Commute
import Mathlib.Data.Nat.Order.Basic
import Mathlib.Algebra.Group.Opposite

/-!
# Cast of natural numbers (additional theorems)

This file proves additional properties about the *canonical* homomorphism from
the natural numbers into an additive monoid with a one (`Nat.cast`).

## Main declarations

* `castAddMonoidHom`: `cast` bundled as an `AddMonoidHom`.
* `castRingHom`: `cast` bundled as a `RingHom`.
-/

-- Porting note: There are many occasions below where we need `simp [map_zero f]`
-- where `simp [map_zero]` should suffice. (Similarly for `map_one`.)
-- See https://leanprover.zulipchat.com/#narrow/stream/287929-mathlib4/topic/simp.20regression.20with.20MonoidHomClass

variable {α β : Type _}

namespace Nat

/-- `Nat.cast : ℕ → α` as an `AddMonoidHom`. -/
def castAddMonoidHom (α : Type _) [AddMonoidWithOne α] :
    ℕ →+ α where
  toFun := Nat.cast
  map_add' := cast_add
  map_zero' := cast_zero
#align nat.cast_add_monoid_hom Nat.castAddMonoidHom

@[simp]
theorem coe_castAddMonoidHom [AddMonoidWithOne α] : (castAddMonoidHom α : ℕ → α) = Nat.cast :=
  rfl
#align nat.coe_cast_add_monoid_hom Nat.coe_castAddMonoidHom

@[simp, norm_cast]
theorem cast_mul [NonAssocSemiring α] (m n : ℕ) : ((m * n : ℕ) : α) = m * n := by
  induction n <;> simp [mul_succ, mul_add, *]
#align nat.cast_mul Nat.cast_mul

/-- `Nat.cast : ℕ → α` as a `RingHom` -/
def castRingHom (α : Type _) [NonAssocSemiring α] : ℕ →+* α :=
  { castAddMonoidHom α with toFun := Nat.cast, map_one' := cast_one, map_mul' := cast_mul }
#align nat.cast_ring_hom Nat.castRingHom

@[simp]
theorem coe_castRingHom [NonAssocSemiring α] : (castRingHom α : ℕ → α) = Nat.cast :=
  rfl
#align nat.coe_cast_ring_hom Nat.coe_castRingHom

theorem cast_commute [NonAssocSemiring α] (n : ℕ) (x : α) : Commute (n : α) x := by
  induction n with
  | zero => rw [Nat.cast_zero]; exact Commute.zero_left x
  | succ n ihn => rw [Nat.cast_succ]; exact ihn.add_left (Commute.one_left x)
#align nat.cast_commute Nat.cast_commute

theorem cast_comm [NonAssocSemiring α] (n : ℕ) (x : α) : (n : α) * x = x * n :=
  (cast_commute n x).eq
#align nat.cast_comm Nat.cast_comm

theorem commute_cast [NonAssocSemiring α] (x : α) (n : ℕ) : Commute x n :=
  (n.cast_commute x).symm
#align nat.commute_cast Nat.commute_cast

section OrderedSemiring

variable [OrderedSemiring α]

@[mono]
theorem mono_cast : Monotone (Nat.cast : ℕ → α) :=
  monotone_nat_of_le_succ fun n ↦ by
    rw [Nat.cast_succ]; exact le_add_of_nonneg_right zero_le_one
#align nat.mono_cast Nat.mono_cast

@[simp]
theorem cast_nonneg (n : ℕ) : 0 ≤ (n : α) :=
  @Nat.cast_zero α _ ▸ mono_cast (Nat.zero_le n)
#align nat.cast_nonneg Nat.cast_nonneg

section Nontrivial

variable [Nontrivial α]

theorem cast_add_one_pos (n : ℕ) : 0 < (n : α) + 1 :=
  zero_lt_one.trans_le <| le_add_of_nonneg_left n.cast_nonneg
#align nat.cast_add_one_pos Nat.cast_add_one_pos

@[simp]
theorem cast_pos {n : ℕ} : (0 : α) < n ↔ 0 < n := by cases n <;> simp [cast_add_one_pos]
#align nat.cast_pos Nat.cast_pos

end Nontrivial

variable [CharZero α] {m n : ℕ}

theorem strictMono_cast : StrictMono (Nat.cast : ℕ → α) :=
  mono_cast.strictMono_of_injective cast_injective
#align nat.strict_mono_cast Nat.strictMono_cast

/-- `Nat.cast : ℕ → α` as an `OrderEmbedding` -/
@[simps! (config := { fullyApplied := false })]
def castOrderEmbedding : ℕ ↪o α :=
  OrderEmbedding.ofStrictMono Nat.cast Nat.strictMono_cast
#align nat.cast_order_embedding Nat.castOrderEmbedding
#align nat.cast_order_embedding_apply Nat.castOrderEmbedding_apply

@[simp, norm_cast]
theorem cast_le : (m : α) ≤ n ↔ m ≤ n :=
  strictMono_cast.le_iff_le
#align nat.cast_le Nat.cast_le

@[simp, norm_cast, mono]
theorem cast_lt : (m : α) < n ↔ m < n :=
  strictMono_cast.lt_iff_lt
#align nat.cast_lt Nat.cast_lt

@[simp, norm_cast]
theorem one_lt_cast : 1 < (n : α) ↔ 1 < n := by rw [← cast_one, cast_lt]
#align nat.one_lt_cast Nat.one_lt_cast

@[simp, norm_cast]
theorem one_le_cast : 1 ≤ (n : α) ↔ 1 ≤ n := by rw [← cast_one, cast_le]
#align nat.one_le_cast Nat.one_le_cast

@[simp, norm_cast]
theorem cast_lt_one : (n : α) < 1 ↔ n = 0 := by
  rw [← cast_one, cast_lt, lt_succ_iff, ← bot_eq_zero, le_bot_iff]
#align nat.cast_lt_one Nat.cast_lt_one

@[simp, norm_cast]
theorem cast_le_one : (n : α) ≤ 1 ↔ n ≤ 1 := by rw [← cast_one, cast_le]
#align nat.cast_le_one Nat.cast_le_one

end OrderedSemiring

/-- A version of `Nat.cast_sub` that works for `ℝ≥0` and `ℚ≥0`. Note that this proof doesn't work
for `ℕ∞` and `ℝ≥0∞`, so we use type-specific lemmas for these types. -/
@[simp, norm_cast]
theorem cast_tsub [CanonicallyOrderedCommSemiring α] [Sub α] [OrderedSub α]
    [ContravariantClass α α (· + ·) (· ≤ ·)] (m n : ℕ) : ↑(m - n) = (m - n : α) := by
  cases' le_total m n with h h
  · rw [tsub_eq_zero_of_le h, cast_zero, tsub_eq_zero_of_le]
    exact mono_cast h
  · rcases le_iff_exists_add'.mp h with ⟨m, rfl⟩
    rw [add_tsub_cancel_right, cast_add, add_tsub_cancel_right]
#align nat.cast_tsub Nat.cast_tsub

@[simp, norm_cast]
theorem cast_min [LinearOrderedSemiring α] {a b : ℕ} : ((min a b : ℕ) : α) = min (a : α) b :=
  (@mono_cast α _).map_min
#align nat.cast_min Nat.cast_min

@[simp, norm_cast]
theorem cast_max [LinearOrderedSemiring α] {a b : ℕ} : ((max a b : ℕ) : α) = max (a : α) b :=
  (@mono_cast α _).map_max
#align nat.cast_max Nat.cast_max

@[simp, norm_cast]
theorem abs_cast [LinearOrderedRing α] (a : ℕ) : |(a : α)| = a :=
  abs_of_nonneg (cast_nonneg a)
#align nat.abs_cast Nat.abs_cast

theorem coe_nat_dvd [Semiring α] {m n : ℕ} (h : m ∣ n) : (m : α) ∣ (n : α) :=
  map_dvd (Nat.castRingHom α) h
#align nat.coe_nat_dvd Nat.coe_nat_dvd

alias coe_nat_dvd ← _root_.Dvd.dvd.natCast

end Nat

instance [AddMonoidWithOne α] [CharZero α] : Nontrivial α where exists_pair_ne :=
  ⟨1, 0, (Nat.cast_one (R := α) ▸ Nat.cast_ne_zero.2 (by decide))⟩

section AddMonoidHomClass

variable {A B F : Type _} [AddMonoidWithOne B]

theorem ext_nat' [AddMonoid A] [AddMonoidHomClass F ℕ A] (f g : F) (h : f 1 = g 1) : f = g :=
  FunLike.ext f g <| by
    intro n
    induction n with
    | zero => simp_rw [Nat.zero_eq, map_zero f, map_zero g]
    | succ n ihn =>
      simp [Nat.succ_eq_add_one, h, ihn]
#align ext_nat' ext_nat'

@[ext]
theorem AddMonoidHom.ext_nat [AddMonoid A] {f g : ℕ →+ A} : f 1 = g 1 → f = g :=
  ext_nat' f g
#align add_monoid_hom.ext_nat AddMonoidHom.ext_nat

variable [AddMonoidWithOne A]

-- these versions are primed so that the `RingHomClass` versions aren't
theorem eq_natCast' [AddMonoidHomClass F ℕ A] (f : F) (h1 : f 1 = 1) : ∀ n : ℕ, f n = n
  | 0 => by simp [map_zero f]
  | n + 1 => by rw [map_add, h1, eq_natCast' f h1 n, Nat.cast_add_one]
#align eq_nat_cast' eq_natCast'

theorem map_natCast' {A} [AddMonoidWithOne A] [AddMonoidHomClass F A B] (f : F) (h : f 1 = 1) :
    ∀ n : ℕ, f n = n
  | 0 => by simp [map_zero f]
  | n + 1 => by
    rw [Nat.cast_add, map_add, Nat.cast_add, map_natCast' f h n, Nat.cast_one, h, Nat.cast_one]
#align map_nat_cast' map_natCast'

end AddMonoidHomClass

section MonoidWithZeroHomClass

variable {A F : Type _} [MulZeroOneClass A]

/-- If two `MonoidWithZeroHom`s agree on the positive naturals they are equal. -/
theorem ext_nat'' [MonoidWithZeroHomClass F ℕ A] (f g : F) (h_pos : ∀ {n : ℕ}, 0 < n → f n = g n) :
    f = g := by
  apply FunLike.ext
  rintro (_ | n)
  · simp [map_zero f, map_zero g]
  · exact h_pos n.succ_pos
#align ext_nat'' ext_nat''

@[ext]
theorem MonoidWithZeroHom.ext_nat {f g : ℕ →*₀ A} : (∀ {n : ℕ}, 0 < n → f n = g n) → f = g :=
  ext_nat'' f g
#align monoid_with_zero_hom.ext_nat MonoidWithZeroHom.ext_nat

end MonoidWithZeroHomClass

section RingHomClass

variable {R S F : Type _} [NonAssocSemiring R] [NonAssocSemiring S]

@[simp]
theorem eq_natCast [RingHomClass F ℕ R] (f : F) : ∀ n, f n = n :=
  eq_natCast' f <| map_one f
#align eq_nat_cast eq_natCast

@[simp]
theorem map_natCast [RingHomClass F R S] (f : F) : ∀ n : ℕ, f (n : R) = n :=
  map_natCast' f <| map_one f
#align map_nat_cast map_natCast

--Porting note: new theorem
@[simp]
theorem map_ofNat [RingHomClass F R S] (f : F)  (n : ℕ) [Nat.AtLeastTwo n] :
    (f (OfNat.ofNat n) : S) = OfNat.ofNat n :=
  map_natCast f n

theorem ext_nat [RingHomClass F ℕ R] (f g : F) : f = g :=
  ext_nat' f g <| by simp only [map_one f, map_one g]
#align ext_nat ext_nat

theorem NeZero.nat_of_injective {n : ℕ} [h : NeZero (n : R)] [RingHomClass F R S] {f : F}
    (hf : Function.Injective f) : NeZero (n : S) :=
  ⟨fun h ↦ NeZero.natCast_ne n R <| hf <| by simpa only [map_natCast, map_zero f] ⟩
#align ne_zero.nat_of_injective NeZero.nat_of_injective

theorem NeZero.nat_of_neZero {R S} [Semiring R] [Semiring S] {F} [RingHomClass F R S] (f : F)
    {n : ℕ} [hn : NeZero (n : S)] : NeZero (n : R) :=
  .of_map (f := f) (neZero := by simp only [map_natCast, hn])
#align ne_zero.nat_of_ne_zero NeZero.nat_of_neZero

end RingHomClass

namespace RingHom

/-- This is primed to match `eq_intCast'`. -/
theorem eq_natCast' {R} [NonAssocSemiring R] (f : ℕ →+* R) : f = Nat.castRingHom R :=
  RingHom.ext <| eq_natCast f
#align ring_hom.eq_nat_cast' RingHom.eq_natCast'

end RingHom

@[simp, norm_cast]
theorem Nat.cast_id (n : ℕ) : n.cast = n :=
  rfl
#align nat.cast_id Nat.cast_id

@[simp]
theorem Nat.castRingHom_nat : Nat.castRingHom ℕ = RingHom.id ℕ :=
  rfl
#align nat.cast_ring_hom_nat Nat.castRingHom_nat

/-- We don't use `RingHomClass` here, since that might cause type-class slowdown for
`Subsingleton`-/
instance Nat.uniqueRingHom {R : Type _} [NonAssocSemiring R] : Unique (ℕ →+* R) where
  default := Nat.castRingHom R
  uniq := RingHom.eq_natCast'

namespace Pi

variable {π : α → Type _} [∀ a, NatCast (π a)]

/- Porting note: manually wrote this instance.
Was `by refine_struct { .. } <;> pi_instance_derive_field` -/
instance natCast : NatCast (∀ a, π a) := { natCast := fun n _ ↦ n }

theorem nat_apply (n : ℕ) (a : α) : (n : ∀ a, π a) a = n :=
  rfl
#align pi.nat_apply Pi.nat_apply

@[simp]
theorem coe_nat (n : ℕ) : (n : ∀ a, π a) = fun _ ↦ ↑n :=
  rfl
#align pi.coe_nat Pi.coe_nat

end Pi

theorem Sum.elim_natCast_natCast {α β γ : Type _} [NatCast γ] (n : ℕ) :
    Sum.elim (n : α → γ) (n : β → γ) = n :=
  @Sum.elim_lam_const_lam_const α β γ n
#align sum.elim_nat_cast_nat_cast Sum.elim_natCast_natCast

/-! ### Order dual -/

open OrderDual

instance [h : NatCast α] : NatCast αᵒᵈ :=
  h

instance [h : AddMonoidWithOne α] : AddMonoidWithOne αᵒᵈ :=
  h

instance [h : AddCommMonoidWithOne α] : AddCommMonoidWithOne αᵒᵈ :=
  h

@[simp]
theorem toDual_natCast [NatCast α] (n : ℕ) : toDual (n : α) = n :=
  rfl
#align to_dual_nat_cast toDual_natCast

@[simp]
theorem ofDual_natCast [NatCast α] (n : ℕ) : (ofDual n : α) = n :=
  rfl
#align of_dual_nat_cast ofDual_natCast

/-! ### Lexicographic order -/

instance [h : NatCast α] : NatCast (Lex α) :=
  h

instance [h : AddMonoidWithOne α] : AddMonoidWithOne (Lex α) :=
  h

instance [h : AddCommMonoidWithOne α] : AddCommMonoidWithOne (Lex α) :=
  h

@[simp]
theorem toLex_natCast [NatCast α] (n : ℕ) : toLex (n : α) = n :=
  rfl
#align to_lex_nat_cast toLex_natCast

@[simp]
theorem ofLex_natCast [NatCast α] (n : ℕ) : (ofLex n : α) = n :=
  rfl
#align of_lex_nat_cast ofLex_natCast


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

! This file was ported from Lean 3 source module category_theory.limits.shapes.zero_morphisms
! leanprover-community/mathlib commit f7707875544ef1f81b32cb68c79e0e24e45a0e76
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Pi.Algebra
import Mathlib.CategoryTheory.Limits.Shapes.Products
import Mathlib.CategoryTheory.Limits.Shapes.Images
import Mathlib.CategoryTheory.IsomorphismClasses
import Mathlib.CategoryTheory.Limits.Shapes.ZeroObjects

/-!
# Zero morphisms and zero objects

A category "has zero morphisms" if there is a designated "zero morphism" in each morphism space,
and compositions of zero morphisms with anything give the zero morphism. (Notice this is extra
structure, not merely a property.)

A category "has a zero object" if it has an object which is both initial and terminal. Having a
zero object provides zero morphisms, as the unique morphisms factoring through the zero object.

## References

* https://en.wikipedia.org/wiki/Zero_morphism
* [F. Borceux, *Handbook of Categorical Algebra 2*][borceux-vol2]
-/

noncomputable section

universe v u

universe v' u'

open CategoryTheory

open CategoryTheory.Category

open Classical

namespace CategoryTheory.Limits

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

variable (D : Type u') [Category.{v'} D]

/-- A category "has zero morphisms" if there is a designated "zero morphism" in each morphism space,
and compositions of zero morphisms with anything give the zero morphism. -/
class HasZeroMorphisms where
  /-- Every morphism space has zero -/
  [Zero : ∀ X Y : C, Zero (X ⟶ Y)]
  /-- `f` composed with `0` is `0` -/
  comp_zero : ∀ {X Y : C} (f : X ⟶ Y) (Z : C), f ≫ (0 : Y ⟶ Z) = (0 : X ⟶ Z) := by aesop
  /-- `0` composed with `f` is `0` -/
  zero_comp : ∀ (X : C) {Y Z : C} (f : Y ⟶ Z), (0 : X ⟶ Y) ≫ f = (0 : X ⟶ Z) := by aesop
#align category_theory.limits.has_zero_morphisms CategoryTheory.Limits.HasZeroMorphisms
#align category_theory.limits.has_zero_morphisms.comp_zero' CategoryTheory.Limits.HasZeroMorphisms.comp_zero
#align category_theory.limits.has_zero_morphisms.zero_comp' CategoryTheory.Limits.HasZeroMorphisms.zero_comp

attribute [instance] HasZeroMorphisms.Zero

variable {C}

@[simp]
theorem comp_zero [HasZeroMorphisms C] {X Y : C} {f : X ⟶ Y} {Z : C} :
    f ≫ (0 : Y ⟶ Z) = (0 : X ⟶ Z) :=
  HasZeroMorphisms.comp_zero f Z
#align category_theory.limits.comp_zero CategoryTheory.Limits.comp_zero

@[simp]
theorem zero_comp [HasZeroMorphisms C] {X : C} {Y Z : C} {f : Y ⟶ Z} :
    (0 : X ⟶ Y) ≫ f = (0 : X ⟶ Z) :=
  HasZeroMorphisms.zero_comp X f
#align category_theory.limits.zero_comp CategoryTheory.Limits.zero_comp

instance hasZeroMorphismsPempty : HasZeroMorphisms (Discrete PEmpty) where Zero := by dee
#align category_theory.limits.has_zero_morphisms_pempty CategoryTheory.Limits.hasZeroMorphismsPempty

instance hasZeroMorphismsPunit : HasZeroMorphisms (Discrete PUnit) where
  Zero := fun X Y => by repeat (constructor)
#align category_theory.limits.has_zero_morphisms_punit CategoryTheory.Limits.hasZeroMorphismsPunit

namespace HasZeroMorphisms

/-- This lemma will be immediately superseded by `ext`, below. -/
private theorem ext_aux (I J : HasZeroMorphisms C)
    (w : ∀ X Y : C, (I.Zero X Y).zero = (J.Zero X Y).zero) : I = J := by
  have : I.Zero = J.Zero := by
    funext X Y
    specialize w X Y
    apply congrArg Zero.mk w
  cases I; cases J
  congr
  · apply proof_irrel_heq
  · apply proof_irrel_heq
-- Porting note: private def; no align

/-- If you're tempted to use this lemma "in the wild", you should probably
carefully consider whether you've made a mistake in allowing two
instances of `HasZeroMorphisms` to exist at all.

See, particularly, the note on `zeroMorphismsOfZeroObject` below.
-/
theorem ext (I J : HasZeroMorphisms C) : I = J := by
  apply ext_aux
  intro X Y
  have : (I.Zero X Y).zero ≫ (J.Zero Y Y).zero = (I.Zero X Y).zero := by
    apply I.zero_comp X (J.Zero Y Y).zero
  have that : (I.Zero X Y).zero ≫ (J.Zero Y Y).zero = (J.Zero X Y).zero := by
    apply J.comp_zero (I.Zero X Y).zero Y
  rw[←this,←that]
#align category_theory.limits.has_zero_morphisms.ext CategoryTheory.Limits.HasZeroMorphisms.ext

instance : Subsingleton (HasZeroMorphisms C) :=
  ⟨ext⟩

end HasZeroMorphisms

open Opposite HasZeroMorphisms

instance hasZeroMorphismsOpposite [HasZeroMorphisms C] : HasZeroMorphisms Cᵒᵖ where
  Zero X Y := ⟨(0 : unop Y ⟶ unop X).op⟩
  comp_zero f Z := congr_arg Quiver.Hom.op (HasZeroMorphisms.zero_comp (unop Z) f.unop)
  zero_comp X {Y Z} (f : Y ⟶  Z) :=
    congrArg Quiver.Hom.op (HasZeroMorphisms.comp_zero f.unop (unop X))
#align category_theory.limits.has_zero_morphisms_opposite CategoryTheory.Limits.hasZeroMorphismsOpposite

section

variable [HasZeroMorphisms C]

theorem zero_of_comp_mono {X Y Z : C} {f : X ⟶ Y} (g : Y ⟶ Z) [Mono g] (h : f ≫ g = 0) : f = 0 := by
  rw [← zero_comp, cancel_mono] at h
  exact h
#align category_theory.limits.zero_of_comp_mono CategoryTheory.Limits.zero_of_comp_mono

theorem zero_of_epi_comp {X Y Z : C} (f : X ⟶ Y) {g : Y ⟶ Z} [Epi f] (h : f ≫ g = 0) : g = 0 := by
  rw [← comp_zero, cancel_epi] at h
  exact h
#align category_theory.limits.zero_of_epi_comp CategoryTheory.Limits.zero_of_epi_comp

theorem eq_zero_of_image_eq_zero {X Y : C} {f : X ⟶ Y} [HasImage f] (w : image.ι f = 0) : f = 0 :=
  by rw [← image.fac f, w, HasZeroMorphisms.comp_zero]
#align category_theory.limits.eq_zero_of_image_eq_zero CategoryTheory.Limits.eq_zero_of_image_eq_zero

theorem nonzero_image_of_nonzero {X Y : C} {f : X ⟶ Y} [HasImage f] (w : f ≠ 0) : image.ι f ≠ 0 :=
  fun h => w (eq_zero_of_image_eq_zero h)
#align category_theory.limits.nonzero_image_of_nonzero CategoryTheory.Limits.nonzero_image_of_nonzero

end

section

variable [HasZeroMorphisms D]

instance : HasZeroMorphisms (C ⥤ D) where
  Zero F G := ⟨{ app := fun X => 0 }⟩
  comp_zero := fun η H => by
    ext X; dsimp; apply comp_zero
  zero_comp := fun F {G H} η => by
    ext X; dsimp; apply zero_comp

@[simp]
theorem zero_app (F G : C ⥤ D) (j : C) : (0 : F ⟶ G).app j = 0 := rfl
#align category_theory.limits.zero_app CategoryTheory.Limits.zero_app

end

namespace IsZero

variable [HasZeroMorphisms C]

theorem eq_zero_of_src {X Y : C} (o : IsZero X) (f : X ⟶ Y) : f = 0 :=
  o.eq_of_src _ _
#align category_theory.limits.is_zero.eq_zero_of_src CategoryTheory.Limits.IsZero.eq_zero_of_src

theorem eq_zero_of_tgt {X Y : C} (o : IsZero Y) (f : X ⟶ Y) : f = 0 :=
  o.eq_of_tgt _ _
#align category_theory.limits.is_zero.eq_zero_of_tgt CategoryTheory.Limits.IsZero.eq_zero_of_tgt

theorem iff_id_eq_zero (X : C) : IsZero X ↔ 𝟙 X = 0 :=
  ⟨fun h => h.eq_of_src _ _, fun h =>
    ⟨fun Y => ⟨⟨⟨0⟩, fun f => by
        rw [← id_comp f, ← id_comp (0: X ⟶ Y), h, zero_comp, zero_comp]; simp only⟩⟩,
    fun Y => ⟨⟨⟨0⟩, fun f => by
        rw [← comp_id f, ← comp_id (0 : Y ⟶  X), h, comp_zero, comp_zero]; simp only ⟩⟩⟩⟩
#align category_theory.limits.is_zero.iff_id_eq_zero CategoryTheory.Limits.IsZero.iff_id_eq_zero

theorem of_mono_zero (X Y : C) [Mono (0 : X ⟶ Y)] : IsZero X :=
  (iff_id_eq_zero X).mpr ((cancel_mono (0 : X ⟶ Y)).1 (by simp))
#align category_theory.limits.is_zero.of_mono_zero CategoryTheory.Limits.IsZero.of_mono_zero

theorem of_epi_zero (X Y : C) [Epi (0 : X ⟶ Y)] : IsZero Y :=
  (iff_id_eq_zero Y).mpr ((cancel_epi (0 : X ⟶ Y)).1 (by simp))
#align category_theory.limits.is_zero.of_epi_zero CategoryTheory.Limits.IsZero.of_epi_zero

theorem of_mono_eq_zero {X Y : C} (f : X ⟶ Y) [Mono f] (h : f = 0) : IsZero X := by
  subst h
  apply of_mono_zero X Y
#align category_theory.limits.is_zero.of_mono_eq_zero CategoryTheory.Limits.IsZero.of_mono_eq_zero

theorem of_epi_eq_zero {X Y : C} (f : X ⟶ Y) [Epi f] (h : f = 0) : IsZero Y := by
  subst h
  apply of_epi_zero X Y
#align category_theory.limits.is_zero.of_epi_eq_zero CategoryTheory.Limits.IsZero.of_epi_eq_zero

theorem iff_isSplitMono_eq_zero {X Y : C} (f : X ⟶ Y) [IsSplitMono f] : IsZero X ↔ f = 0 := by
  rw [iff_id_eq_zero]
  constructor
  · intro h
    rw [← Category.id_comp f, h, zero_comp]
  · intro h
    rw [← IsSplitMono.id f]
    simp [h]
#align category_theory.limits.is_zero.iff_is_split_mono_eq_zero CategoryTheory.Limits.IsZero.iff_isSplitMono_eq_zero

theorem iff_isSplitEpi_eq_zero {X Y : C} (f : X ⟶ Y) [IsSplitEpi f] : IsZero Y ↔ f = 0 := by
  rw [iff_id_eq_zero]
  constructor
  · intro h
    rw [← Category.comp_id f, h, comp_zero]
  · intro h
    rw [← IsSplitEpi.id f]
    simp [h]
#align category_theory.limits.is_zero.iff_is_split_epi_eq_zero CategoryTheory.Limits.IsZero.iff_isSplitEpi_eq_zero

theorem of_mono {X Y : C} (f : X ⟶ Y) [Mono f] (i : IsZero Y) : IsZero X := by
  have hf := i.eq_zero_of_tgt f
  subst hf
  exact IsZero.of_mono_zero X Y
#align category_theory.limits.is_zero.of_mono CategoryTheory.Limits.IsZero.of_mono

theorem of_epi {X Y : C} (f : X ⟶ Y) [Epi f] (i : IsZero X) : IsZero Y := by
  have hf := i.eq_zero_of_src f
  subst hf
  exact IsZero.of_epi_zero X Y
#align category_theory.limits.is_zero.of_epi CategoryTheory.Limits.IsZero.of_epi

end IsZero

/-- A category with a zero object has zero morphisms.

    It is rarely a good idea to use this. Many categories that have a zero object have zero
    morphisms for some other reason, for example from additivity. Library code that uses
    `zeroMorphismsOfZeroObject` will then be incompatible with these categories because
    the `HasZeroMorphisms` instances will not be definitionally equal. For this reason library
    code should generally ask for an instance of `HasZeroMorphisms` separately, even if it already
    asks for an instance of `HasZeroObjects`. -/
def IsZero.hasZeroMorphisms {O : C} (hO : IsZero O) : HasZeroMorphisms C where
  Zero X Y := { zero := hO.from_ X ≫ hO.to_ Y }
  zero_comp X {Y Z} f := by
    change (hO.from_ X ≫ hO.to_ Y) ≫ f = hO.from_ X ≫ hO.to_ Z
    rw [Category.assoc]
    congr
    apply hO.eq_of_src
  comp_zero {X Y} f Z := by
    change f ≫ (hO.from_ Y ≫ hO.to_ Z) = hO.from_ X ≫ hO.to_ Z
    rw [← Category.assoc]
    congr
    apply hO.eq_of_tgt
#align category_theory.limits.is_zero.has_zero_morphisms CategoryTheory.Limits.IsZero.hasZeroMorphisms

namespace HasZeroObject

variable [HasZeroObject C]

open ZeroObject

/-- A category with a zero object has zero morphisms.

    It is rarely a good idea to use this. Many categories that have a zero object have zero
    morphisms for some other reason, for example from additivity. Library code that uses
    `zeroMorphismsOfZeroObject` will then be incompatible with these categories because
    the `has_zero_morphisms` instances will not be definitionally equal. For this reason library
    code should generally ask for an instance of `HasZeroMorphisms` separately, even if it already
    asks for an instance of `HasZeroObjects`. -/
def zeroMorphismsOfZeroObject : HasZeroMorphisms C where
  Zero X Y := { zero := (default : X ⟶ 0) ≫ default }
  zero_comp X {Y Z} f := by
    change ( (default : X ⟶  0)  ≫ default) ≫ f = (default : X ⟶  0) ≫ default
    rw [Category.assoc]
    congr
    simp only [eq_iff_true_of_subsingleton]
  comp_zero {X Y} f Z := by
    change f ≫ (default : Y ⟶  0)  ≫ default = (default : X ⟶  0) ≫ default
    rw [← Category.assoc]
    congr
    simp only [eq_iff_true_of_subsingleton]
#align category_theory.limits.has_zero_object.zero_morphisms_of_zero_object CategoryTheory.Limits.HasZeroObject.zeroMorphismsOfZeroObject

section HasZeroMorphisms

variable [HasZeroMorphisms C]

@[simp]
theorem zeroIsoIsInitial_hom {X : C} (t : IsInitial X) : (zeroIsoIsInitial t).hom = 0 := by ext
#align category_theory.limits.has_zero_object.zero_iso_is_initial_hom CategoryTheory.Limits.HasZeroObject.zeroIsoIsInitial_hom

@[simp]
theorem zeroIsoIsInitial_inv {X : C} (t : IsInitial X) : (zeroIsoIsInitial t).inv = 0 := by ext
#align category_theory.limits.has_zero_object.zero_iso_is_initial_inv CategoryTheory.Limits.HasZeroObject.zeroIsoIsInitial_inv

@[simp]
theorem zeroIsoIsTerminal_hom {X : C} (t : IsTerminal X) : (zeroIsoIsTerminal t).hom = 0 := by ext
#align category_theory.limits.has_zero_object.zero_iso_is_terminal_hom CategoryTheory.Limits.HasZeroObject.zeroIsoIsTerminal_hom

@[simp]
theorem zeroIsoIsTerminal_inv {X : C} (t : IsTerminal X) : (zeroIsoIsTerminal t).inv = 0 := by ext
#align category_theory.limits.has_zero_object.zero_iso_is_terminal_inv CategoryTheory.Limits.HasZeroObject.zeroIsoIsTerminal_inv

@[simp]
theorem zeroIsoInitial_hom [HasInitial C] : zeroIsoInitial.hom = (0 : 0 ⟶ ⊥_ C) := by ext
#align category_theory.limits.has_zero_object.zero_iso_initial_hom CategoryTheory.Limits.HasZeroObject.zeroIsoInitial_hom

@[simp]
theorem zeroIsoInitial_inv [HasInitial C] : zeroIsoInitial.inv = (0 : ⊥_ C ⟶ 0) := by ext
#align category_theory.limits.has_zero_object.zero_iso_initial_inv CategoryTheory.Limits.HasZeroObject.zeroIsoInitial_inv

@[simp]
theorem zeroIsoTerminal_hom [HasTerminal C] : zeroIsoTerminal.hom = (0 : 0 ⟶ ⊤_ C) := by ext
#align category_theory.limits.has_zero_object.zero_iso_terminal_hom CategoryTheory.Limits.HasZeroObject.zeroIsoTerminal_hom

@[simp]
theorem zeroIsoTerminal_inv [HasTerminal C] : zeroIsoTerminal.inv = (0 : ⊤_ C ⟶ 0) := by ext
#align category_theory.limits.has_zero_object.zero_iso_terminal_inv CategoryTheory.Limits.HasZeroObject.zeroIsoTerminal_inv

end HasZeroMorphisms

open ZeroObject

instance {B : Type _} [Category B] : HasZeroObject (B ⥤ C) :=
  (((CategoryTheory.Functor.const B).obj (0 : C)).isZero fun _ => isZero_zero _).hasZeroObject

end HasZeroObject

open ZeroObject

variable {D}

@[simp]
theorem IsZero.map [HasZeroObject D] [HasZeroMorphisms D] {F : C ⥤ D} (hF : IsZero F) {X Y : C}
    (f : X ⟶ Y) : F.map f = 0 :=
  (hF.obj _).eq_of_src _ _
#align category_theory.limits.is_zero.map CategoryTheory.Limits.IsZero.map

@[simp]
theorem _root_.CategoryTheory.Functor.zero_obj [HasZeroObject D] (X : C) :
    IsZero ((0 : C ⥤ D).obj X) :=
  (isZero_zero _).obj _
#align category_theory.functor.zero_obj CategoryTheory.Functor.zero_obj

@[simp]
theorem _root_.CategoryTheory.zero_map [HasZeroObject D] [HasZeroMorphisms D] {X Y : C}
    (f : X ⟶ Y) : (0 : C ⥤ D).map f = 0 :=
  (isZero_zero _).map _
#align category_theory.zero_map CategoryTheory.zero_map

section

variable [HasZeroObject C] [HasZeroMorphisms C]

open ZeroObject

@[simp]
theorem id_zero : 𝟙 (0 : C) = (0 : (0 : C) ⟶  0) := by apply HasZeroObject.from_zero_ext
#align category_theory.limits.id_zero CategoryTheory.Limits.id_zero

-- This can't be a `simp` lemma because the left hand side would be a metavariable.
/-- An arrow ending in the zero object is zero -/
theorem zero_of_to_zero {X : C} (f : X ⟶ 0) : f = 0 := by ext
#align category_theory.limits.zero_of_to_zero CategoryTheory.Limits.zero_of_to_zero

theorem zero_of_target_iso_zero {X Y : C} (f : X ⟶ Y) (i : Y ≅ 0) : f = 0 := by
  have h : f = f ≫ i.hom ≫ 𝟙 0 ≫ i.inv := by simp only [Iso.hom_inv_id, id_comp, comp_id]
  simpa using h
#align category_theory.limits.zero_of_target_iso_zero CategoryTheory.Limits.zero_of_target_iso_zero

/-- An arrow starting at the zero object is zero -/
theorem zero_of_from_zero {X : C} (f : 0 ⟶ X) : f = 0 := by ext
#align category_theory.limits.zero_of_from_zero CategoryTheory.Limits.zero_of_from_zero

theorem zero_of_source_iso_zero' {X Y : C} (f : X ⟶ Y) (i : IsIsomorphic X 0) : f = 0 :=
  zero_of_source_iso_zero f (Nonempty.some i)
#align category_theory.limits.zero_of_source_iso_zero' CategoryTheory.Limits.zero_of_source_iso_zero'

theorem zero_of_target_iso_zero' {X Y : C} (f : X ⟶ Y) (i : IsIsomorphic Y 0) : f = 0 :=
  zero_of_target_iso_zero f (Nonempty.some i)
#align category_theory.limits.zero_of_target_iso_zero' CategoryTheory.Limits.zero_of_target_iso_zero'

theorem mono_of_source_iso_zero {X Y : C} (f : X ⟶ Y) (i : X ≅ 0) : Mono f :=
  ⟨fun {Z} g h _ => by rw [zero_of_target_iso_zero g i, zero_of_target_iso_zero h i]⟩
#align category_theory.limits.mono_of_source_iso_zero CategoryTheory.Limits.mono_of_source_iso_zero

theorem epi_of_target_iso_zero {X Y : C} (f : X ⟶ Y) (i : Y ≅ 0) : Epi f :=
  ⟨fun {Z} g h _ => by rw [zero_of_source_iso_zero g i, zero_of_source_iso_zero h i]⟩
#align category_theory.limits.epi_of_target_iso_zero CategoryTheory.Limits.epi_of_target_iso_zero

/-- An object `X` has `𝟙 X = 0` if and only if it is isomorphic to the zero object.

Because `X ≅ 0` contains data (even if a subsingleton), we express this `↔` as an `≃`.
-/
def idZeroEquivIsoZero (X : C) : 𝟙 X = 0 ≃ (X ≅ 0) where
  toFun h :=
    { hom := 0
      inv := 0 }
  invFun i := zero_of_target_iso_zero (𝟙 X) i
  left_inv := by aesop_cat
  right_inv := by aesop_cat
#align category_theory.limits.id_zero_equiv_iso_zero CategoryTheory.Limits.idZeroEquivIsoZero

@[simp]
theorem idZeroEquivIsoZero_apply_hom (X : C) (h : 𝟙 X = 0) : ((idZeroEquivIsoZero X) h).hom = 0 :=
  rfl
#align category_theory.limits.id_zero_equiv_iso_zero_apply_hom CategoryTheory.Limits.idZeroEquivIsoZero_apply_hom

@[simp]
theorem idZeroEquivIsoZero_apply_inv (X : C) (h : 𝟙 X = 0) : ((idZeroEquivIsoZero X) h).inv = 0 :=
  rfl
#align category_theory.limits.id_zero_equiv_iso_zero_apply_inv CategoryTheory.Limits.idZeroEquivIsoZero_apply_inv

/-- If `0 : X ⟶ Y` is an monomorphism, then `X ≅ 0`. -/
@[simps]
def isoZeroOfMonoZero {X Y : C} (h : Mono (0 : X ⟶ Y)) : X ≅ 0 where
  hom := 0
  inv := 0
  hom_inv_id := (cancel_mono (0 : X ⟶ Y)).mp (by simp)
#align category_theory.limits.iso_zero_of_mono_zero CategoryTheory.Limits.isoZeroOfMonoZero

/-- If `0 : X ⟶ Y` is an epimorphism, then `Y ≅ 0`. -/
@[simps]
def isoZeroOfEpiZero {X Y : C} (h : Epi (0 : X ⟶ Y)) : Y ≅ 0 where
  hom := 0
  inv := 0
  hom_inv_id := (cancel_epi (0 : X ⟶ Y)).mp (by simp)
#align category_theory.limits.iso_zero_of_epi_zero CategoryTheory.Limits.isoZeroOfEpiZero

/-- If a monomorphism out of `X` is zero, then `X ≅ 0`. -/
def isoZeroOfMonoEqZero {X Y : C} {f : X ⟶ Y} [Mono f] (h : f = 0) : X ≅ 0 := by
  subst h
  apply isoZeroOfMonoZero ‹_›
#align category_theory.limits.iso_zero_of_mono_eq_zero CategoryTheory.Limits.isoZeroOfMonoEqZero

/-- If an epimorphism in to `Y` is zero, then `Y ≅ 0`. -/
def isoZeroOfEpiEqZero {X Y : C} {f : X ⟶ Y} [Epi f] (h : f = 0) : Y ≅ 0 := by
  subst h
  apply isoZeroOfEpiZero ‹_›
#align category_theory.limits.iso_zero_of_epi_eq_zero CategoryTheory.Limits.isoZeroOfEpiEqZero

/-- If an object `X` is isomorphic to 0, there's no need to use choice to construct
an explicit isomorphism: the zero morphism suffices. -/
def isoOfIsIsomorphicZero {X : C} (P : IsIsomorphic X 0) : X ≅ 0 where
  hom := 0
  inv := 0
  hom_inv_id := by
    cases' P with P
    rw [←P.hom_inv_id,←Category.id_comp P.inv]
    apply Eq.symm
    simp only [id_comp, Iso.hom_inv_id, comp_zero]
    apply (idZeroEquivIsoZero X).invFun P
  inv_hom_id := by simp
#align category_theory.limits.iso_of_is_isomorphic_zero CategoryTheory.Limits.isoOfIsIsomorphicZero

end

section IsIso

variable [HasZeroMorphisms C]

/-- A zero morphism `0 : X ⟶ Y` is an isomorphism if and only if
the identities on both `X` and `Y` are zero.
-/
@[simps]
def isIsoZeroEquiv (X Y : C) : IsIso (0 : X ⟶ Y) ≃ 𝟙 X = 0 ∧ 𝟙 Y = 0 where
  toFun := by
    intro i
    rw [← IsIso.hom_inv_id (0 : X ⟶ Y)]
    rw [← IsIso.inv_hom_id (0 : X ⟶ Y)]
    simp only [eq_self_iff_true,comp_zero,and_self,zero_comp]
  invFun h := ⟨⟨(0 : Y ⟶ X), by aesop_cat⟩⟩
  left_inv := by aesop_cat
  right_inv := by aesop_cat
#align category_theory.limits.is_iso_zero_equiv CategoryTheory.Limits.isIsoZeroEquiv

-- Porting note: simp solves these
attribute [-simp, nolint simpNF] isIsoZeroEquiv_apply isIsoZeroEquiv_symm_apply

/-- A zero morphism `0 : X ⟶ X` is an isomorphism if and only if
the identity on `X` is zero.
-/
def isIsoZeroSelfEquiv (X : C) : IsIso (0 : X ⟶ X) ≃ 𝟙 X = 0 := by simpa using isIsoZeroEquiv X X
#align category_theory.limits.is_iso_zero_self_equiv CategoryTheory.Limits.isIsoZeroSelfEquiv

variable [HasZeroObject C]

open ZeroObject

/-- A zero morphism `0 : X ⟶ Y` is an isomorphism if and only if
`X` and `Y` are isomorphic to the zero object.
-/
def isIsoZeroEquivIsoZero (X Y : C) : IsIso (0 : X ⟶ Y) ≃ (X ≅ 0) × (Y ≅ 0) := by
  -- This is lame, because `prod` can't cope with `Prop`, so we can't use `Equiv.prodCongr`.
  refine' (isIsoZeroEquiv X Y).trans _
  symm
  fconstructor
  · rintro ⟨eX, eY⟩
    fconstructor
    exact (idZeroEquivIsoZero X).symm eX
    exact (idZeroEquivIsoZero Y).symm eY
  · rintro ⟨hX, hY⟩
    fconstructor
    exact (idZeroEquivIsoZero X) hX
    exact (idZeroEquivIsoZero Y) hY
  · aesop_cat
  · aesop_cat
#align category_theory.limits.is_iso_zero_equiv_iso_zero CategoryTheory.Limits.isIsoZeroEquivIsoZero

theorem isIso_of_source_target_iso_zero {X Y : C} (f : X ⟶ Y) (i : X ≅ 0) (j : Y ≅ 0) : IsIso f :=
  by
  rw [zero_of_source_iso_zero f i]
  exact (isIsoZeroEquivIsoZero _ _).invFun ⟨i, j⟩
#align category_theory.limits.is_iso_of_source_target_iso_zero CategoryTheory.Limits.isIso_of_source_target_iso_zero

/-- A zero morphism `0 : X ⟶ X` is an isomorphism if and only if
`X` is isomorphic to the zero object.
-/
def isIsoZeroSelfEquivIsoZero (X : C) : IsIso (0 : X ⟶ X) ≃ (X ≅ 0) :=
  (isIsoZeroEquivIsoZero X X).trans subsingletonProdSelfEquiv
#align category_theory.limits.is_iso_zero_self_equiv_iso_zero CategoryTheory.Limits.isIsoZeroSelfEquivIsoZero

end IsIso

/-- If there are zero morphisms, any initial object is a zero object. -/
theorem hasZeroObject_of_hasInitial_object [HasZeroMorphisms C] [HasInitial C] : HasZeroObject C :=
  by
  refine' ⟨⟨⊥_ C, fun X => ⟨⟨⟨0⟩, by aesop_cat⟩⟩, fun X => ⟨⟨⟨0⟩, fun f => _⟩⟩⟩⟩
  calc
    f = f ≫ 𝟙 _ := (Category.comp_id _).symm
    _ = f ≫ 0 := by congr!
    _ = 0 := HasZeroMorphisms.comp_zero _ _

#align category_theory.limits.has_zero_object_of_has_initial_object CategoryTheory.Limits.hasZeroObject_of_hasInitial_object

/-- If there are zero morphisms, any terminal object is a zero object. -/
theorem hasZeroObject_of_hasTerminal_object [HasZeroMorphisms C] [HasTerminal C] :
    HasZeroObject C := by
  refine' ⟨⟨⊤_ C, fun X => ⟨⟨⟨0⟩, fun f => _⟩⟩, fun X => ⟨⟨⟨0⟩, by aesop_cat⟩⟩⟩⟩
  calc
    f = 𝟙 _ ≫ f := (Category.id_comp _).symm
    _ = 0 ≫ f := by congr!
    _ = 0 := zero_comp

#align category_theory.limits.has_zero_object_of_has_terminal_object CategoryTheory.Limits.hasZeroObject_of_hasTerminal_object

section Image

variable [HasZeroMorphisms C]

theorem image_ι_comp_eq_zero {X Y Z : C} {f : X ⟶ Y} {g : Y ⟶ Z} [HasImage f]
    [Epi (factorThruImage f)] (h : f ≫ g = 0) : image.ι f ≫ g = 0 :=
  zero_of_epi_comp (factorThruImage f) <| by simp [h]
#align category_theory.limits.image_ι_comp_eq_zero CategoryTheory.Limits.image_ι_comp_eq_zero

theorem comp_factorThruImage_eq_zero {X Y Z : C} {f : X ⟶ Y} {g : Y ⟶ Z} [HasImage g]
    (h : f ≫ g = 0) : f ≫ factorThruImage g = 0 :=
  zero_of_comp_mono (image.ι g) <| by simp [h]
#align category_theory.limits.comp_factor_thru_image_eq_zero CategoryTheory.Limits.comp_factorThruImage_eq_zero

variable [HasZeroObject C]

open ZeroObject

/-- The zero morphism has a `MonoFactorisation` through the zero object.
-/
@[simps]
def monoFactorisationZero (X Y : C) : MonoFactorisation (0 : X ⟶ Y)  where
  I := 0
  m := 0
  e := 0
#align category_theory.limits.mono_factorisation_zero CategoryTheory.Limits.monoFactorisationZero

/-- The factorisation through the zero object is an image factorisation.
-/
def imageFactorisationZero (X Y : C) : ImageFactorisation (0 : X ⟶ Y) where
  F := monoFactorisationZero X Y
  isImage := { lift := fun F' => 0 }
#align category_theory.limits.image_factorisation_zero CategoryTheory.Limits.imageFactorisationZero

instance hasImage_zero {X Y : C} : HasImage (0 : X ⟶ Y) :=
  HasImage.mk <| imageFactorisationZero _ _
#align category_theory.limits.has_image_zero CategoryTheory.Limits.hasImage_zero

/-- The image of a zero morphism is the zero object. -/
def imageZero {X Y : C} : image (0 : X ⟶ Y) ≅ 0 :=
  IsImage.isoExt (Image.isImage (0 : X ⟶ Y)) (imageFactorisationZero X Y).isImage
#align category_theory.limits.image_zero CategoryTheory.Limits.imageZero

/-- The image of a morphism which is equal to zero is the zero object. -/
def imageZero' {X Y : C} {f : X ⟶ Y} (h : f = 0) [HasImage f] : image f ≅ 0 :=
  image.eqToIso h ≪≫ imageZero
#align category_theory.limits.image_zero' CategoryTheory.Limits.imageZero'

@[simp]
theorem image.ι_zero {X Y : C} [HasImage (0 : X ⟶ Y)] : image.ι (0 : X ⟶ Y) = 0 := by
  rw [← image.lift_fac (monoFactorisationZero X Y)]
  simp
#align category_theory.limits.image.ι_zero CategoryTheory.Limits.image.ι_zero

/-- If we know `f = 0`,
it requires a little work to conclude `image.ι f = 0`,
because `f = g` only implies `image f ≅ image g`.
-/
@[simp]
theorem image.ι_zero' [HasEqualizers C] {X Y : C} {f : X ⟶ Y} (h : f = 0) [HasImage f] :
    image.ι f = 0 := by
  rw [image.eq_fac h]
  simp
#align category_theory.limits.image.ι_zero' CategoryTheory.Limits.image.ι_zero'

end Image

/-- In the presence of zero morphisms, coprojections into a coproduct are (split) monomorphisms. -/
instance isSplitMono_sigma_ι {β : Type u'} [HasZeroMorphisms C] (f : β → C)
    [HasColimit (Discrete.functor f)] (b : β) : IsSplitMono (Sigma.ι f b) :=
  IsSplitMono.mk' { retraction := Sigma.desc <| Pi.single b (𝟙 _) }
#align category_theory.limits.is_split_mono_sigma_ι CategoryTheory.Limits.isSplitMono_sigma_ι

/-- In the presence of zero morphisms, projections into a product are (split) epimorphisms. -/
instance isSplitEpi_pi_π {β : Type u'} [HasZeroMorphisms C] (f : β → C)
    [HasLimit (Discrete.functor f)] (b : β) : IsSplitEpi (Pi.π f b) :=
  IsSplitEpi.mk' { section_ := Pi.lift <| Pi.single b (𝟙 _) }
#align category_theory.limits.is_split_epi_pi_π CategoryTheory.Limits.isSplitEpi_pi_π

/-- In the presence of zero morphisms, coprojections into a coproduct are (split) monomorphisms. -/
instance isSplitMono_coprod_inl [HasZeroMorphisms C] {X Y : C} [HasColimit (pair X Y)] :
    IsSplitMono (coprod.inl : X ⟶ X ⨿ Y) :=
  IsSplitMono.mk' { retraction := coprod.desc (𝟙 X) 0 }
#align category_theory.limits.is_split_mono_coprod_inl CategoryTheory.Limits.isSplitMono_coprod_inl

/-- In the presence of zero morphisms, coprojections into a coproduct are (split) monomorphisms. -/
instance isSplitMono_coprod_inr [HasZeroMorphisms C] {X Y : C} [HasColimit (pair X Y)] :
    IsSplitMono (coprod.inr : Y ⟶ X ⨿ Y) :=
  IsSplitMono.mk' { retraction := coprod.desc 0 (𝟙 Y) }
#align category_theory.limits.is_split_mono_coprod_inr CategoryTheory.Limits.isSplitMono_coprod_inr

/-- In the presence of zero morphisms, projections into a product are (split) epimorphisms. -/
instance isSplitEpi_prod_fst [HasZeroMorphisms C] {X Y : C} [HasLimit (pair X Y)] :
    IsSplitEpi (prod.fst : X ⨯ Y ⟶ X) :=
  IsSplitEpi.mk' { section_ := prod.lift (𝟙 X) 0 }
#align category_theory.limits.is_split_epi_prod_fst CategoryTheory.Limits.isSplitEpi_prod_fst

/-- In the presence of zero morphisms, projections into a product are (split) epimorphisms. -/
instance isSplitEpi_prod_snd [HasZeroMorphisms C] {X Y : C} [HasLimit (pair X Y)] :
    IsSplitEpi (prod.snd : X ⨯ Y ⟶ Y) :=
  IsSplitEpi.mk' { section_ := prod.lift 0 (𝟙 Y) }
#align category_theory.limits.is_split_epi_prod_snd CategoryTheory.Limits.isSplitEpi_prod_snd

end CategoryTheory.Limits


example : Prop := ∀ n, (n:Nat) + n = n.succ
example : Prop := ∀ n, n.succ = (n:Nat) + n
example : Prop := ∀ n, (n:Nat) + n.succ = n
example : Prop := ∀ n, n.succ + (n:Nat) = n
example : Prop := ∀ n, (n.succ:Nat) + n = n
example : Prop := ∀ n, (n:Nat).succ + n = n

def fib: Nat → Nat
| 0 => 0
| 1 => 1
| n + 2 => fib n + fib (n + 1)

theorem fib50Eq : fib 50 = 12586269025 :=
  rfl

inductive type : Type
  | A : type
  | B  : type

inductive val : type → Type
  | cA : val type.A
  | cB : val type.B

inductive wrap : Type
  | val : ∀ {t : type}, (val t) → wrap

def f : wrap → Nat
  | wrap.val val.cA => 1
  | _ => 1

example (a : Nat) : True := by
  have : ∀ n, n ≥ 0 → a ≤ a := fun _ _ => Nat.leRefl ..
  exact True.intro

example (ᾰ : Nat) : True := by
  have : ∀ n, n ≥ 0 → ᾰ ≤ ᾰ := fun _ _ => Nat.leRefl ..
  exact True.intro

inductive Vec.{u} (α : Type u) : Nat → Type u
  | nil  : Vec α 0
  | cons : α → {n : Nat} → Vec α n → Vec α (Nat.succ n) -- TODO: investigate why +1 doesn't work here

constant Vars : Type

structure Lang :=
  (funcs : Nat → Type)
  (consts : Type)

inductive Term (L : Lang) : Type
  | const_term : L.consts → Term L
  | var_term   : Vars → Term L
  | func_term  (n : Nat) (f : L.funcs n) (v : Vec (Term L) n) : Term L


import data.nat.basic

-- 1ª demostración
example
  (n m : ℕ)
  (hn : n ≠ 0)
  (hm : n ≤ m)
  : m ≠ 0 :=
begin
  intro h,
  simp * at *,
end

-- 2ª demostración
example
  (n m : ℕ)
  (hn : n ≠ 0)
  (hm : n ≤ m)
  : m ≠ 0 :=
λ h, by simp * at *


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

! This file was ported from Lean 3 source module ring_theory.ring_hom.surjective
! leanprover-community/mathlib commit 831c494092374cfe9f50591ed0ac81a25efc5b86
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.RingTheory.LocalProperties

/-!

# The meta properties of surjective ring homomorphisms.

-/

namespace RingHom

open TensorProduct

open TensorProduct Algebra.TensorProduct

-- mathport name: exprsurjective
local notation "surjective" => fun {X Y : Type _} [CommRing X] [CommRing Y] => fun f : X →+* Y =>
  Function.Surjective f

theorem surjective_stableUnderComposition : StableUnderComposition surjective :=
  by
  introv R hf hg
  exact hg.comp hf
#align ring_hom.surjective_stable_under_composition RingHom.surjective_stableUnderComposition

theorem surjective_respectsIso : RespectsIso surjective :=
  by
  apply surjective_stable_under_composition.respects_iso
  intros
  exact e.surjective
#align ring_hom.surjective_respects_iso RingHom.surjective_respectsIso

theorem surjective_stableUnderBaseChange : StableUnderBaseChange surjective :=
  by
  refine' stable_under_base_change.mk _ surjective_respects_iso _
  classical
    introv h x
    skip
    induction' x using TensorProduct.induction_on with x y x y ex ey
    · exact ⟨0, map_zero _⟩
    · obtain ⟨y, rfl⟩ := h y
      use y • x
      dsimp
      rw [TensorProduct.smul_tmul, Algebra.algebraMap_eq_smul_one]
    · obtain ⟨⟨x, rfl⟩, ⟨y, rfl⟩⟩ := ex, ey
      exact ⟨x + y, map_add _ x y⟩
#align ring_hom.surjective_stable_under_base_change RingHom.surjective_stableUnderBaseChange

open BigOperators

theorem surjective_ofLocalizationSpan : OfLocalizationSpan surjective :=
  by
  introv R hs H
  skip
  letI := f.to_algebra
  show Function.Surjective (Algebra.ofId R S)
  rw [← Algebra.range_top_iff_surjective, eq_top_iff]
  rintro x -
  obtain ⟨l, hl⟩ :=
    (Finsupp.mem_span_iff_total R s 1).mp
      (show _ ∈ Ideal.span s by
        rw [hs]
        trivial)
  fapply
    Subalgebra.mem_of_finset_sum_eq_one_of_pow_smul_mem _ l.support (fun x : s => f x) fun x : s =>
      f (l x)
  · dsimp only
    simp_rw [← _root_.map_mul, ← map_sum, ← f.map_one]
    exact f.congr_arg hl
  · exact fun _ => Set.mem_range_self _
  · exact fun _ => Set.mem_range_self _
  · intro r
    obtain ⟨y, hy⟩ := H r (IsLocalization.mk' _ x (1 : Submonoid.powers (f r)))
    obtain ⟨z, ⟨_, n, rfl⟩, rfl⟩ := IsLocalization.mk'_surjective (Submonoid.powers (r : R)) y
    erw [IsLocalization.map_mk', IsLocalization.eq] at hy
    obtain ⟨⟨_, m, rfl⟩, hm⟩ := hy
    refine' ⟨m + n, _⟩
    dsimp at hm⊢
    simp_rw [_root_.one_mul, ← _root_.mul_assoc, ← map_pow, ← f.map_mul, ← pow_add, map_pow] at hm
    exact ⟨_, hm⟩
#align ring_hom.surjective_of_localization_span RingHom.surjective_ofLocalizationSpan

end RingHom


/-
Copyright (c) 2021 Eric Wieser. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Eric Wieser
-/
import ring_theory.subring.basic
import group_theory.subgroup.pointwise
import ring_theory.subsemiring.pointwise
import data.set.pointwise.basic

/-! # Pointwise instances on `subring`s

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

This file provides the action `subring.pointwise_mul_action` which matches the action of
`mul_action_set`.

This actions is available in the `pointwise` locale.

## Implementation notes

This file is almost identical to `ring_theory/subsemiring/pointwise.lean`. Where possible, try to
keep them in sync.

-/

open set

variables {M R : Type*}

namespace subring

section monoid
variables [monoid M] [ring R] [mul_semiring_action M R]

/-- The action on a subring corresponding to applying the action to every element.

This is available as an instance in the `pointwise` locale. -/
protected def pointwise_mul_action : mul_action M (subring R) :=
{ smul := λ a S, S.map (mul_semiring_action.to_ring_hom _ _ a),
  one_smul := λ S,
    (congr_arg (λ f, S.map f) (ring_hom.ext $ by exact one_smul M)).trans S.map_id,
  mul_smul := λ a₁ a₂ S,
    (congr_arg (λ f, S.map f) (ring_hom.ext $ by exact mul_smul _ _)).trans (S.map_map _ _).symm }

localized "attribute [instance] subring.pointwise_mul_action" in pointwise
open_locale pointwise

lemma pointwise_smul_def {a : M} (S : subring R) :
  a • S = S.map (mul_semiring_action.to_ring_hom _ _ a) := rfl

@[simp] lemma coe_pointwise_smul (m : M) (S : subring R) : ↑(m • S) = m • (S : set R) := rfl

@[simp] lemma pointwise_smul_to_add_subgroup (m : M) (S : subring R) :
  (m • S).to_add_subgroup = m • S.to_add_subgroup := rfl

@[simp] lemma pointwise_smul_to_subsemiring (m : M) (S : subring R) :
  (m • S).to_subsemiring = m • S.to_subsemiring := rfl

lemma smul_mem_pointwise_smul (m : M) (r : R) (S : subring R) : r ∈ S → m • r ∈ m • S :=
(set.smul_mem_smul_set : _ → _ ∈ m • (S : set R))

lemma mem_smul_pointwise_iff_exists (m : M) (r : R) (S : subring R) :
  r ∈ m • S ↔ ∃ (s : R), s ∈ S ∧ m • s = r :=
(set.mem_smul_set : r ∈ m • (S : set R) ↔ _)

@[simp] lemma smul_bot (a : M) : a • (⊥ : subring R) = ⊥ := map_bot _
lemma smul_sup (a : M) (S T : subring R) : a • (S ⊔ T) = a • S ⊔ a • T := map_sup _ _ _

lemma smul_closure (a : M) (s : set R) : a • closure s = closure (a • s) :=
ring_hom.map_closure _ _

instance pointwise_central_scalar [mul_semiring_action Mᵐᵒᵖ R] [is_central_scalar M R] :
  is_central_scalar M (subring R) :=
⟨λ a S, congr_arg (λ f, S.map f) $ ring_hom.ext $ by exact op_smul_eq_smul _⟩

end monoid

section group
variables [group M] [ring R] [mul_semiring_action M R]

open_locale pointwise

@[simp] lemma smul_mem_pointwise_smul_iff {a : M} {S : subring R} {x : R} :
  a • x ∈ a • S ↔ x ∈ S :=
smul_mem_smul_set_iff

lemma mem_pointwise_smul_iff_inv_smul_mem {a : M} {S : subring R} {x : R} :
  x ∈ a • S ↔ a⁻¹ • x ∈ S :=
mem_smul_set_iff_inv_smul_mem

lemma mem_inv_pointwise_smul_iff {a : M} {S : subring R} {x : R} : x ∈ a⁻¹ • S ↔ a • x ∈ S :=
mem_inv_smul_set_iff

@[simp] lemma pointwise_smul_le_pointwise_smul_iff {a : M} {S T : subring R} :
  a • S ≤ a • T ↔ S ≤ T :=
set_smul_subset_set_smul_iff

lemma pointwise_smul_subset_iff {a : M} {S T : subring R} : a • S ≤ T ↔ S ≤ a⁻¹ • T :=
set_smul_subset_iff

lemma subset_pointwise_smul_iff {a : M} {S T : subring R} : S ≤ a • T ↔ a⁻¹ • S ≤ T :=
subset_set_smul_iff

/-! TODO: add `equiv_smul` like we have for subgroup. -/

end group

section group_with_zero
variables [group_with_zero M] [ring R] [mul_semiring_action M R]

open_locale pointwise

@[simp] lemma smul_mem_pointwise_smul_iff₀ {a : M} (ha : a ≠ 0) (S : subring R)
  (x : R) : a • x ∈ a • S ↔ x ∈ S :=
smul_mem_smul_set_iff₀ ha (S : set R) x

lemma mem_pointwise_smul_iff_inv_smul_mem₀ {a : M} (ha : a ≠ 0) (S : subring R) (x : R) :
  x ∈ a • S ↔ a⁻¹ • x ∈ S :=
mem_smul_set_iff_inv_smul_mem₀ ha (S : set R) x

lemma mem_inv_pointwise_smul_iff₀ {a : M} (ha : a ≠ 0) (S : subring R) (x : R) :
  x ∈ a⁻¹ • S ↔ a • x ∈ S :=
mem_inv_smul_set_iff₀ ha (S : set R) x

@[simp] lemma pointwise_smul_le_pointwise_smul_iff₀ {a : M} (ha : a ≠ 0) {S T : subring R} :
  a • S ≤ a • T ↔ S ≤ T :=
set_smul_subset_set_smul_iff₀ ha

lemma pointwise_smul_le_iff₀ {a : M} (ha : a ≠ 0) {S T : subring R} : a • S ≤ T ↔ S ≤ a⁻¹ • T :=
set_smul_subset_iff₀ ha

lemma le_pointwise_smul_iff₀ {a : M} (ha : a ≠ 0) {S T : subring R} : S ≤ a • T ↔ a⁻¹ • S ≤ T :=
subset_set_smul_iff₀ ha

end group_with_zero

end subring