/-
Copyright (c) 2019 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.analysis.normed_space.operator_norm
import Mathlib.analysis.normed_space.add_torsor
import Mathlib.topology.bases
import Mathlib.linear_algebra.finite_dimensional
import Mathlib.tactic.omega.default
import Mathlib.PostPort

universes u v w x u_1 u_2

namespace Mathlib

/-!
# Finite dimensional normed spaces over complete fields

Over a complete nondiscrete field, in finite dimension, all norms are equivalent and all linear maps
are continuous. Moreover, a finite-dimensional subspace is always complete and closed.

## Main results:

* `linear_map.continuous_of_finite_dimensional` : a linear map on a finite-dimensional space over a
  complete field is continuous.
* `finite_dimensional.complete` : a finite-dimensional space over a complete field is complete. This
  is not registered as an instance, as the field would be an unknown metavariable in typeclass
  resolution.
* `submodule.closed_of_finite_dimensional` : a finite-dimensional subspace over a complete field is
  closed
* `finite_dimensional.proper` : a finite-dimensional space over a proper field is proper. This
  is not registered as an instance, as the field would be an unknown metavariable in typeclass
  resolution. It is however registered as an instance for `𝕜 = ℝ` and `𝕜 = ℂ`. As properness
  implies completeness, there is no need to also register `finite_dimensional.complete` on `ℝ` or
  `ℂ`.

## Implementation notes

The fact that all norms are equivalent is not written explicitly, as it would mean having two norms
on a single space, which is not the way type classes work. However, if one has a
finite-dimensional vector space `E` with a norm, and a copy `E'` of this type with another norm,
then the identities from `E` to `E'` and from `E'`to `E` are continuous thanks to
`linear_map.continuous_of_finite_dimensional`. This gives the desired norm equivalence.
-/

/-- A linear map on `ι → 𝕜` (where `ι` is a fintype) is continuous -/
theorem linear_map.continuous_on_pi {ι : Type w} [fintype ι] {𝕜 : Type u} [normed_field 𝕜]
    {E : Type v} [add_comm_group E] [vector_space 𝕜 E] [topological_space E]
    [topological_add_group E] [topological_vector_space 𝕜 E] (f : linear_map 𝕜 (ι → 𝕜) E) :
    continuous ⇑f :=
  eq.mpr
    (id
      (Eq._oldrec (Eq.refl (continuous ⇑f))
        (funext fun (x : ι → 𝕜) => linear_map.pi_apply_eq_sum_univ f x)))
    (continuous_finset_sum finset.univ
      fun (i : ι) (hi : i ∈ finset.univ) => continuous.smul (continuous_apply i) continuous_const)

/-- In finite dimension over a complete field, the canonical identification (in terms of a basis)
with `𝕜^n` together with its sup norm is continuous. This is the nontrivial part in the fact that
all norms are equivalent in finite dimension.

This statement is superceded by the fact that every linear map on a finite-dimensional space is
continuous, in `linear_map.continuous_of_finite_dimensional`. -/
theorem continuous_equiv_fun_basis {𝕜 : Type u} [nondiscrete_normed_field 𝕜] {E : Type v}
    [normed_group E] [normed_space 𝕜 E] [complete_space 𝕜] {ι : Type v} [fintype ι] (ξ : ι → E)
    (hξ : is_basis 𝕜 ξ) : continuous ⇑(is_basis.equiv_fun hξ) :=
  sorry

/-- Any linear map on a finite dimensional space over a complete field is continuous. -/
theorem linear_map.continuous_of_finite_dimensional {𝕜 : Type u} [nondiscrete_normed_field 𝕜]
    {E : Type v} [normed_group E] [normed_space 𝕜 E] {F' : Type x} [add_comm_group F']
    [vector_space 𝕜 F'] [topological_space F'] [topological_add_group F']
    [topological_vector_space 𝕜 F'] [complete_space 𝕜] [finite_dimensional 𝕜 E]
    (f : linear_map 𝕜 E F') : continuous ⇑f :=
  sorry

theorem affine_map.continuous_of_finite_dimensional {𝕜 : Type u} [nondiscrete_normed_field 𝕜]
    {E : Type v} [normed_group E] [normed_space 𝕜 E] {F : Type w} [normed_group F]
    [normed_space 𝕜 F] [complete_space 𝕜] {PE : Type u_1} {PF : Type u_2} [metric_space PE]
    [normed_add_torsor E PE] [metric_space PF] [normed_add_torsor F PF] [finite_dimensional 𝕜 E]
    (f : affine_map 𝕜 PE PF) : continuous ⇑f :=
  iff.mp affine_map.continuous_linear_iff
    (linear_map.continuous_of_finite_dimensional (affine_map.linear f))

/-- The continuous linear map induced by a linear map on a finite dimensional space -/
def linear_map.to_continuous_linear_map {𝕜 : Type u} [nondiscrete_normed_field 𝕜] {E : Type v}
    [normed_group E] [normed_space 𝕜 E] {F' : Type x} [add_comm_group F'] [vector_space 𝕜 F']
    [topological_space F'] [topological_add_group F'] [topological_vector_space 𝕜 F']
    [complete_space 𝕜] [finite_dimensional 𝕜 E] (f : linear_map 𝕜 E F') :
    continuous_linear_map 𝕜 E F' :=
  continuous_linear_map.mk (linear_map.mk (linear_map.to_fun f) sorry sorry)

/-- The continuous linear equivalence induced by a linear equivalence on a finite dimensional space. -/
def linear_equiv.to_continuous_linear_equiv {𝕜 : Type u} [nondiscrete_normed_field 𝕜] {E : Type v}
    [normed_group E] [normed_space 𝕜 E] {F : Type w} [normed_group F] [normed_space 𝕜 F]
    [complete_space 𝕜] [finite_dimensional 𝕜 E] (e : linear_equiv 𝕜 E F) :
    continuous_linear_equiv 𝕜 E F :=
  continuous_linear_equiv.mk
    (linear_equiv.mk (linear_equiv.to_fun e) sorry sorry (linear_equiv.inv_fun e) sorry sorry)

/-- Two finite-dimensional normed spaces are continuously linearly equivalent if they have the same
(finite) dimension. -/
theorem finite_dimensional.nonempty_continuous_linear_equiv_of_findim_eq {𝕜 : Type u}
    [nondiscrete_normed_field 𝕜] {E : Type v} [normed_group E] [normed_space 𝕜 E] {F : Type w}
    [normed_group F] [normed_space 𝕜 F] [complete_space 𝕜] [finite_dimensional 𝕜 E]
    [finite_dimensional 𝕜 F]
    (cond : finite_dimensional.findim 𝕜 E = finite_dimensional.findim 𝕜 F) :
    Nonempty (continuous_linear_equiv 𝕜 E F) :=
  nonempty.map linear_equiv.to_continuous_linear_equiv
    (finite_dimensional.nonempty_linear_equiv_of_findim_eq cond)

/-- Two finite-dimensional normed spaces are continuously linearly equivalent if and only if they
have the same (finite) dimension. -/
theorem finite_dimensional.nonempty_continuous_linear_equiv_iff_findim_eq {𝕜 : Type u}
    [nondiscrete_normed_field 𝕜] {E : Type v} [normed_group E] [normed_space 𝕜 E] {F : Type w}
    [normed_group F] [normed_space 𝕜 F] [complete_space 𝕜] [finite_dimensional 𝕜 E]
    [finite_dimensional 𝕜 F] :
    Nonempty (continuous_linear_equiv 𝕜 E F) ↔
        finite_dimensional.findim 𝕜 E = finite_dimensional.findim 𝕜 F :=
  sorry

/-- A continuous linear equivalence between two finite-dimensional normed spaces of the same
(finite) dimension. -/
def continuous_linear_equiv.of_findim_eq {𝕜 : Type u} [nondiscrete_normed_field 𝕜] {E : Type v}
    [normed_group E] [normed_space 𝕜 E] {F : Type w} [normed_group F] [normed_space 𝕜 F]
    [complete_space 𝕜] [finite_dimensional 𝕜 E] [finite_dimensional 𝕜 F]
    (cond : finite_dimensional.findim 𝕜 E = finite_dimensional.findim 𝕜 F) :
    continuous_linear_equiv 𝕜 E F :=
  linear_equiv.to_continuous_linear_equiv (finite_dimensional.linear_equiv.of_findim_eq E F cond)

/-- Construct a continuous linear map given the value at a finite basis. -/
def is_basis.constrL {𝕜 : Type u} [nondiscrete_normed_field 𝕜] {E : Type v} [normed_group E]
    [normed_space 𝕜 E] {F : Type w} [normed_group F] [normed_space 𝕜 F] [complete_space 𝕜]
    {ι : Type u_1} [fintype ι] {v : ι → E} (hv : is_basis 𝕜 v) (f : ι → F) :
    continuous_linear_map 𝕜 E F :=
  linear_map.to_continuous_linear_map (is_basis.constr hv f)

@[simp] theorem is_basis.coe_constrL {𝕜 : Type u} [nondiscrete_normed_field 𝕜] {E : Type v}
    [normed_group E] [normed_space 𝕜 E] {F : Type w} [normed_group F] [normed_space 𝕜 F]


/-
Copyright (c) 2022 Sina Hazratpour. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
----------------

# Algebra of Functions: Part I
Sina Hazratpour
Introduction to Proof
MATH 301, Johns Hopkins University, Fall 2022
-/

import ..prooflab
import .lec2_algebraic_identities

set_option pp.beta true
set_option pp.generalized_field_notation false
-- set_option pp.all true

namespace PROOFS

variables {A B C X Y Z U V W : Type} -- "Let A B ... W be types". We are introducing types A ... W so that we do not have to repeat ourselves for each example/lemma/theorem context declration.

/-! # Functions
- Type of functions: In `lec0_intro.lean` we saw that given types `A` and `B` we can create new types. One of these new types is the function type `A → B`. For any types `A` and `B`, we can make a new type `A → B` called the __function type__ of `A` and `B`. The  elements of function types are __functions__.

- The idea of functions: A __function__ `f : A → B` is a program that takes an element `a : A` as an input argument and returns a unique element `f a : B` as output. We also say `f` "assigns" the element `fa` to an element `a`. And sometimes we say `f` "takes" or "maps" `a` to `f a`.

- Domain and codomain:
In the expression `f : A → B`, the object/type `A` is called the __domain__ (sometimes called __source__) of `f` and the object/type `B` the __codomain__ (sometimes called __tartget__) of `f`.

- How to specify functions:
Suppose we have a program/rule which outputs `b : B` for an input `a : A`. Note that `b` might depend on `a`. We represent this program as a function `λ a, b : A → B`. This is the so-called __function abstraction__.

- How to use functions:
This is the so-called function __application__ (aka __evaluation__). We'll talk more about this in a minute.
-- TODO: write more about lambda.
-/

/-! ## Some examples of functions -/

/-
Let `double : ℕ → ℕ` be the function defined by `double (n) = 2 * n`:
-/
def double :=
λ n : ℕ, (2 * n)
-- we use the symbol `:=` for defining functions in Lean. Whatever follows `:=` is the definition of the function.

#check double

-- all functions in Lean are __total__ which means we are not going to limit/constrain the input other than the limit/constraint by its type.
def half :=
λ n, n/2

#check half
#check half 1
#eval half 1
#eval half 2

#check 1/2
#check 1/(2:ℚ)
#check (1:ℚ)/2

def rational_one := (1 : ℚ)

#check rational_one/2

example :
  rational_one/2 = 1/(2:ℚ) :=
begin
refl,
end

def half_neg :=
-- Lean interprets `n` to be an integer (the default way)
λ n, (-n : ℤ)/2

def half_neg_alt :=
-- Lean interprets `n` to be a natural number since we told it so.
λ n : ℕ , (-n : ℤ)/2

#check half_neg

/-
 __Second way (non-lambda way) to specify functions__: Another way to specify the `double` function which avoids the lambda notation is as follows. This is somewhat closer to the way most mathematicians specify their functions.

This way resembles the way we wrote lemmas/theorems.
-/
def double' (n : ℕ) :=
2 * n
#check double'
#reduce double'

def double_alt :=
λ n : ℕ, n + n
-- syntactically this function is different than `double` and `double'`.
-- #check double_alt

/-
Let `square : ℕ → ℕ`  be the function defined by `square (n) = n * n`:
-/
def square (n : ℕ) :=
n * n
#check square
#eval square 3

/-
Let `g : ℚ × ℚ → ℝ` be the function defined by `g (x,y) = x^2 + y^2`.
-/

#check ((2.2 : ℚ), (1.7 : ℚ))
#eval  (2.2, 1.7)

#check (1/(3:ℚ), 7/(5:ℚ))

#check ( (1/3, 7/5) : ℚ × ℚ )

def rational_sum_of_squares (z : ℚ × ℚ) :=
(z.1)^2 + (z.2)^2

#eval rational_sum_of_squares (3/5, 4/5)

-- `.1` and `.2` are projections from the cartesian space `ℚ × ℚ` to `ℚ` which pick the first and second coordinates.
#eval (52,4).1
#eval (52,4).2
#eval (52.3676,4.9041).1
#eval ( (52.3676,4.9041).1 : ℚ)

--#check real_sum_of_squares
--#eval real_sum_of_squares (1/2 , -1/2)

-- __the third way__ of definition by __pattern matching__
def switch : bool → bool
| tt := ff
| ff := tt

#check bool
#check tt
#check ff
#check switch
#eval switch ff

-- We can also specify a function by assigning an output for each possible input.
def nat_of_bool : bool → ℕ
| ff := 0
| tt := 1

#check nat_of_bool
--#check nat_of_bool
--#eval nat_of_bool ff

-- __if ... then ... else ...__ style of definition
def bool_of_nat (n : ℕ) :=
if n = 0 then ff else tt

-- #check bool_of_nat

def int_of_nat : ℕ → ℤ :=
λ n , n

#check int_of_nat

def self_of_nat (n : ℕ) :=
n

#check self_of_nat

def is_even (n : ℕ) :=
∃ k : ℕ, n = 2 * k

#check is_even

#check (0 = 1)

def is_odd (n : ℕ) :=
∃ k : ℕ, n = 2 * k + 1

#check is_odd

-- this where we ended on Wednesday.

-- The absolute value function
#check (abs : ℚ → ℚ)
#check (abs : ℝ → ℝ)
#check abs (-3 : ℚ)
#eval abs (-3 : ℚ)
#check (abs_add : ∀ a b : ℝ, abs (a + b) ≤ abs a + abs b)

/- CHALLENGE: define a function `distance_rat : ℚ → ℚ → ℚ` which takes two real numbers `x : ℚ ` and `y : ℚ ` as inputs and returns as output the standard Euclidean distance `| x - y |` between them.
-/
def distance_rat (x y : ℚ) :=
abs(x - y)

#check int.nat_abs

#check abs
def distance_nat (x y : ℤ) :=
int.nat_abs ( x - y )

#check distance_rat
#check distance_nat

#check distance_nat (1/3) (1/2)
#eval distance_nat (1/3) (1/2)

#check distance_rat (3/2 : ℚ) (1/2 : ℚ) -- should be a rational number
#eval distance_rat (3/2 : ℚ) (1/2 : ℚ) -- should evaluate to 1
#eval distance_rat (1/3) (1/2) -- should evaluate to 1

end PROOFS


-- Tactics

-- Based on the nice tactic tutorial at
--   https://leanprover-community.github.io/extras/tactic_writing.html

import algebra.order.ring
import analysis.calculus.tangent_cone
import data.real.basic
import data.complex.basic
import init.meta.interactive_base
import init.meta.rewrite_tactic
import simple
import tactic.norm_num

open complex (abs)
open interactive (parse)
open interactive.types
open lean.parser (ident many tk)
open_locale nnreal

meta def aux (q : pexpr) (t : tactic unit) : tactic expr := do
  e ← tactic.i_to_expr q,
  (_, h) ← tactic.solve_aux e t,
  return h

meta def try_aux (q : pexpr) (t : tactic unit) : tactic (option expr) := do
  e ← tactic.i_to_expr q,
  (tactic.solve_aux e t >>= λ h, pure $ some h.snd) <|> return none

meta def pexact (q : pexpr) : tactic unit := do
  t ← tactic.i_to_expr q,
  tactic.exact t

meta def is_ineq : expr → bool
| `(_ ≤ _) := tt
| `(_ < _) := tt
| `(_ ≥ _) := tt
| `(_ > _) := tt
| _ := ff

-- Flip ≤/≥ and </> in target
meta def tactic.interactive.flip_ineq : tactic unit := do
  t ← tactic.target,
  match t with
  | `(%%a ≤ %%b) := do t ← tactic.i_to_expr ``(simple.ge_to_le), _ ← tactic.apply t, return ()
  | `(%%a < %%b) := do t ← tactic.i_to_expr ``(simple.gt_to_lt), _ ← tactic.apply t, return ()
  | `(%%a ≥ %%b) := do t ← tactic.i_to_expr ``(simple.le_to_ge), _ ← tactic.apply t, return ()
  | `(%%a > %%b) := do t ← tactic.i_to_expr ``(simple.lt_to_gt), _ ← tactic.apply t, return ()
  | _ := tactic.fail "flip_ineq got a non-inequality"
  end

-- [f h | f ∈ fs, h ∈ hs]
meta def calls (fs : list pexpr) (hs : list pexpr) : tactic (list expr) := do
  ys ← flip monad.mapm fs (λ f, do
    let maybe_p := λ e : pexpr, some <$> tactic.i_to_expr ``(%%f %%e) <|> return none,
    let maybe_e := λ e : expr, maybe_p (to_pexpr e),
    ys0 ← tactic.local_context >>= monad.mapm maybe_e,
    ys1 ← monad.mapm maybe_p hs,
    return (ys0 ++ ys1)),
  return (list.filter_map id ys.join)

-- note each f h for f ∈ fs, h ∈ hs
meta def notes (fs : list pexpr) (hs : list pexpr) : tactic unit :=
  calls fs hs >>= monad.mapm' (λ e, do _ ← tactic.note `this none e, return ())

-- Straightforward propagation of inequalities.
-- Roughly, handles a bunch of cases of the form
--   f x {≤,<} f y
-- where f is increasing and x ≤ y is immediate.
meta def bound (hs : list pexpr) : tactic unit := do
  -- Helpful diagnostic: tactic.target >>= λ e, tactic.fail format! "bailing: {e}"
  notes [``(le_of_lt)] hs,  -- Turn each < into a ≤
  let lemmas := hs ++ [
    -- Basics
    ``(le_rfl),
    -- 0 ≤, 0 <
    ``(sq_nonneg _),
    ``(mul_pos), ``(mul_nonneg), ``(div_pos), ``(div_nonneg),
    ``(simple.pow_pos'), ``(simple.pow_nonneg'),
    ``(simple.ring_sub_nonneg), ``(simple.ring_add_nonneg), ``(simple.ring_sub_pos),
    ``(inv_nonneg.mpr), ``(inv_pos.mpr),
    ``(nnreal.coe_pos.mpr), ``(simple.nat_nonneg _), ``(nnreal.coe_nonneg _),
    ``(simple.real_abs_nonneg), ``(complex.abs_nonneg _), ``(norm_nonneg), ``(dist_nonneg),
    ``(nat.zero_lt_succ _),
    -- ≤
    ``(simple.div_le_div_right), ``(div_le_div),
    ``(simple.sq_increasing),
    ``(mul_le_mul_of_nonneg_left), ``(mul_le_mul_of_nonneg_right), ``(mul_le_mul),
    ``(simple.ring_sub_le_sub), ``(simple.ring_add_le_add),
    ``(simple.div_le_one), ``(simple.div_cancel_le), ``(div_le_self),
    ``(simple.le_add_nonneg_right), ``(simple.le_add_nonneg_left),
    ``(pow_le_pow_of_le_left), ``(inv_le_inv_of_le),
    -- Triangle inequalities
    ``(dist_triangle _ _ _), ``(simple.abs_sub'), ``(simple.abs_sub_ge'), ``(complex.abs_add _ _), ``(norm_sub_le),
    -- <
    ``(div_lt_self),
    ``(simple.ring_add_lt_add_left), ``(simple.ring_add_lt_add_right),
    ``(nnreal.coe_lt_coe.mpr),
    -- min and max
    ``(min_le_right), ``(min_le_left), ``(le_max_left), ``(le_max_right), ``(le_min), ``(max_le),
    ``(lt_min), ``(max_lt),
    -- Constants
    ``(zero_le_one), ``(zero_lt_one), ``(ennreal.zero_lt_one),
    ``(zero_le_bit0.mpr), ``(zero_lt_bit0.mpr),
    ``(simple.zero_lt_bit1), ``(simple.zero_le_bit1),
    ``(nat.bit0_lt), ``(nat.bit1_lt),
    ``(nat.bit0_le), ``(nat.bit1_le),
    ``(bit0_le_bit0.mpr), ``(bit0_lt_bit0.mpr), ``(bit1_le_bit1.mpr), ``(bit1_lt_bit1.mpr),
    ``(norm_num.le_one_bit0 _), ``(norm_num.lt_one_bit0 _),
    ``(with_top.zero_lt_top)
  ],
  tactic.apply_rules lemmas [] 32 {unify := ff}

meta def tactic.interactive.notes (fs : parse pexpr_list) (hs : parse opt_pexpr_list) : tactic unit := notes fs hs
meta def tactic.interactive.bound (hs : parse opt_pexpr_list) : tactic unit := bound hs

section positive_tests
variables n : ℕ
variables x y : ℝ
variables u : ℝ≥0
variables z : ℂ
lemma test_pos_sq (h : x > 0) : x^2 > 0 := by bound
lemma test_pos_mul (p : x > 0) (q : y > 0) : x * y > 0 := by bound
lemma test_pos_div (p : x > 0) (q : y > 0) : x / y > 0 := by bound
lemma test_pos_4 : 0 < 4 := by bound
lemma test_pos_7 : 0 < 7 := by bound
lemma test_pos_4_real : 0 < (4 : ℝ) := by bound
lemma test_pos_7_real : 0 < (7 : ℝ) := by bound
lemma test_pos_zero_one : 0 < (1 : ℝ) := by bound
lemma test_pos_nnreal (h : u > 0) : 0 < (u : ℝ) := by bound
lemma test_pos_pow : 0 < 2^n := by bound
lemma test_pos_inv : 0 < (1 : ℝ)⁻¹ := by bound
end positive_tests

section nonneg_tests
variables n : ℕ
variables x y : ℝ
variables u : ℝ≥0
variables z : ℂ
lemma test_abs : 0 ≤ abs z := by bound
lemma test_abs_ge : abs z ≥ 0 := by bound
lemma test_nn_sq : x^2 ≥ 0 := by bound
lemma test_mul (p : x ≥ 0) (q : y ≥ 0) : x * y ≥ 0 := by bound
lemma test_div (p : x ≥ 0) (q : y ≥ 0) : x / y ≥ 0 := by bound
lemma test_add (p : x ≥ 0) (q : y ≥ 0) : x + y ≥ 0 := by bound
lemma test_nat : (n : ℝ) ≥ 0 := by bound
lemma test_num : 0 ≤ 7 := by bound
lemma test_num_real : 0 ≤ (7 : ℝ) := by bound
lemma test_zero_one : 0 ≤ (1 : ℝ) := by bound
lemma test_nnreal : 0 ≤ (u : ℝ) := by bound
lemma test_zero : 0 ≤ (0 : ℝ) := by bound
lemma test_pow : 0 ≤ 2^n := by bound
lemma test_inv : 0 ≤ (0 : ℝ)⁻¹ := by bound
end nonneg_tests

section bound_tests
variables a b c x y : ℝ
variables z : ℂ
variables n : ℕ
lemma test_sq (n : x ≥ 0) (h : x ≤ y) : x^2 ≤ y^2 := by bound
lemma test_sq_ge (n : x ≥ 0) (h : x ≤ y) : y^2 ≥ x^2 := by bound
lemma test_mul_left (n : a ≥ 0) (h : x ≤ y) : a * x ≤ a * y := by bound
lemma test_mul_right (n : a ≥ 0) (h : x ≤ y) : x * a ≤ y * a := by bound
lemma test_mul_both (bp : b ≥ 0) (xp : x ≥ 0) (ab : a ≤ b) (xy : x ≤ y) : a * x ≤ b * y := by bound
lemma test_abs_mul (h : x ≤ y) : abs z * x ≤ abs z * y := by bound
lemma test_add_left (h : x ≤ y) : a + x ≤ a + y := by bound
lemma test_add_right (h : x ≤ y) : x + a ≤ y + a := by bound
lemma test_add_both (ab : a ≤ b) (xy : x ≤ y) : a + x ≤ b + y := by bound
lemma test_sub_left (h : x ≥ y) : a - x ≤ a - y := by bound
lemma test_sub_right (h : x ≤ y) : x - a ≤ y - a := by bound
lemma test_sub_both (ab : a ≤ b) (xy : x ≥ y) : a - x ≤ b - y := by bound
lemma test_sub_pos (h : x < y) : y - x > 0 := by bound
lemma test_le_of_lt (h : x > 0) : x ≥ 0 := by bound
lemma test_extra (f : ℕ → ℝ) (h : ∀ n, f n ≥ 0) : f n ≥ 0 := by bound [h n]
lemma test_1_4 : (1 : ℝ) < 4 := by bound
lemma test_2_4 : (2 : ℝ) < 4 := by bound
lemma test_div_left (hc : c ≥ 0) (h : a ≤ b) : a / c ≤ b / c := by bound
lemma test_div_right (ha : a ≥ 0) (hc : c > 0) (h : b ≥ c) : a / b ≤ a / c := by bound
lemma test_coe (x y : ℝ≥0) (h : x < y) : (x : ℝ) < y := by bound
lemma test_dist : dist a c ≤ dist a b + dist b c := by bound
end bound_tests

-- Interactive test for notes
/-
lemma test_calls {a b c : ℝ} (ab : a < b) (cp : c > 0) : a ≤ c := begin
  notes [le_of_lt] [norm_sum_le],
end
-/


/-
Copyright (c) 2020 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.pi
! leanprover-community/mathlib commit 10bf4f825ad729c5653adc039dafa3622e7f93c9
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.CategoryTheory.Pi.Basic
import Mathbin.CategoryTheory.Limits.HasLimits

/-!
# Limits in the category of indexed families of objects.

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

Given a functor `F : J ⥤ Π i, C i` into a category of indexed families,
1. we can assemble a collection of cones over `F ⋙ pi.eval C i` into a cone over `F`
2. if all those cones are limit cones, the assembled cone is a limit cone, and
3. if we have limits for each of `F ⋙ pi.eval C i`, we can produce a
   `has_limit F` instance
-/

open CategoryTheory

open CategoryTheory.Limits

namespace CategoryTheory.pi

universe v₁ v₂ u₁ u₂

variable {I : Type v₁} {C : I → Type u₁} [∀ i, Category.{v₁} (C i)]

variable {J : Type v₁} [SmallCategory J]

variable {F : J ⥤ ∀ i, C i}

#print CategoryTheory.pi.coneCompEval /-
/-- A cone over `F : J ⥤ Π i, C i` has as its components cones over each of the `F ⋙ pi.eval C i`.
-/
def coneCompEval (c : Cone F) (i : I) : Cone (F ⋙ Pi.eval C i)
    where
  pt := c.pt i
  π :=
    { app := fun j => c.π.app j i
      naturality' := fun j j' f => congr_fun (c.π.naturality f) i }
#align category_theory.pi.cone_comp_eval CategoryTheory.pi.coneCompEval
-/

#print CategoryTheory.pi.coconeCompEval /-
/--
A cocone over `F : J ⥤ Π i, C i` has as its components cocones over each of the `F ⋙ pi.eval C i`.
-/
def coconeCompEval (c : Cocone F) (i : I) : Cocone (F ⋙ Pi.eval C i)
    where
  pt := c.pt i
  ι :=
    { app := fun j => c.ι.app j i
      naturality' := fun j j' f => congr_fun (c.ι.naturality f) i }
#align category_theory.pi.cocone_comp_eval CategoryTheory.pi.coconeCompEval
-/

#print CategoryTheory.pi.coneOfConeCompEval /-
/--
Given a family of cones over the `F ⋙ pi.eval C i`, we can assemble these together as a `cone F`.
-/
def coneOfConeCompEval (c : ∀ i, Cone (F ⋙ Pi.eval C i)) : Cone F
    where
  pt i := (c i).pt
  π :=
    { app := fun j i => (c i).π.app j
      naturality' := fun j j' f => by
        ext i
        exact (c i).π.naturality f }
#align category_theory.pi.cone_of_cone_comp_eval CategoryTheory.pi.coneOfConeCompEval
-/

#print CategoryTheory.pi.coconeOfCoconeCompEval /-
/-- Given a family of cocones over the `F ⋙ pi.eval C i`,
we can assemble these together as a `cocone F`.
-/
def coconeOfCoconeCompEval (c : ∀ i, Cocone (F ⋙ Pi.eval C i)) : Cocone F
    where
  pt i := (c i).pt
  ι :=
    { app := fun j i => (c i).ι.app j
      naturality' := fun j j' f => by
        ext i
        exact (c i).ι.naturality f }
#align category_theory.pi.cocone_of_cocone_comp_eval CategoryTheory.pi.coconeOfCoconeCompEval
-/

#print CategoryTheory.pi.coneOfConeEvalIsLimit /-
/-- Given a family of limit cones over the `F ⋙ pi.eval C i`,
assembling them together as a `cone F` produces a limit cone.
-/
def coneOfConeEvalIsLimit {c : ∀ i, Cone (F ⋙ Pi.eval C i)} (P : ∀ i, IsLimit (c i)) :
    IsLimit (coneOfConeCompEval c)
    where
  lift s i := (P i).lift (coneCompEval s i)
  fac s j := by
    ext i
    exact (P i).fac (cone_comp_eval s i) j
  uniq s m w := by
    ext i
    exact (P i).uniq (cone_comp_eval s i) (m i) fun j => congr_fun (w j) i
#align category_theory.pi.cone_of_cone_eval_is_limit CategoryTheory.pi.coneOfConeEvalIsLimit
-/

#print CategoryTheory.pi.coconeOfCoconeEvalIsColimit /-
/-- Given a family of colimit cocones over the `F ⋙ pi.eval C i`,
assembling them together as a `cocone F` produces a colimit cocone.
-/
def coconeOfCoconeEvalIsColimit {c : ∀ i, Cocone (F ⋙ Pi.eval C i)} (P : ∀ i, IsColimit (c i)) :
    IsColimit (coconeOfCoconeCompEval c)
    where
  desc s i := (P i).desc (coconeCompEval s i)
  fac s j := by
    ext i
    exact (P i).fac (cocone_comp_eval s i) j
  uniq s m w := by
    ext i
    exact (P i).uniq (cocone_comp_eval s i) (m i) fun j => congr_fun (w j) i
#align category_theory.pi.cocone_of_cocone_eval_is_colimit CategoryTheory.pi.coconeOfCoconeEvalIsColimit
-/

section

variable [∀ i, HasLimit (F ⋙ Pi.eval C i)]

#print CategoryTheory.pi.hasLimit_of_hasLimit_comp_eval /-
/-- If we have a functor `F : J ⥤ Π i, C i` into a category of indexed families,
and we have limits for each of the `F ⋙ pi.eval C i`,
then `F` has a limit.
-/
theorem hasLimit_of_hasLimit_comp_eval : HasLimit F :=
  HasLimit.mk
    { Cone := coneOfConeCompEval fun i => limit.cone _
      IsLimit := coneOfConeEvalIsLimit fun i => limit.isLimit _ }
#align category_theory.pi.has_limit_of_has_limit_comp_eval CategoryTheory.pi.hasLimit_of_hasLimit_comp_eval
-/

end

section

variable [∀ i, HasColimit (F ⋙ Pi.eval C i)]

#print CategoryTheory.pi.hasColimit_of_hasColimit_comp_eval /-
/-- If we have a functor `F : J ⥤ Π i, C i` into a category of indexed families,
and colimits exist for each of the `F ⋙ pi.eval C i`,
there is a colimit for `F`.
-/
theorem hasColimit_of_hasColimit_comp_eval : HasColimit F :=
  HasColimit.mk
    { Cocone := coconeOfCoconeCompEval fun i => colimit.cocone _
      IsColimit := coconeOfCoconeEvalIsColimit fun i => colimit.isColimit _ }
#align category_theory.pi.has_colimit_of_has_colimit_comp_eval CategoryTheory.pi.hasColimit_of_hasColimit_comp_eval
-/

end

/-!
As an example, we can use this to construct particular shapes of limits
in a category of indexed families.

With the addition of
`import category_theory.limits.shapes.types`
we can use:
```
local attribute [instance] has_limit_of_has_limit_comp_eval
example : has_binary_products (I → Type v₁) := ⟨by apply_instance⟩
```
-/

end CategoryTheory.pi


import algebra.ring algebra.module data.set.basic tactic.ring data.equiv data.quot

-- remove "data.equiv" in PR version
-- ring.localization

universes u v

-- <migrations>
-- <move to algebra.group>

class is_submonoid (α : Type u) [monoid α] (S : set α) : Prop :=
(one_mem : (1:α) ∈ S)
(mul_mem : ∀ {s t}, s ∈ S → t ∈ S → s*t ∈ S)

-- </move>

-- <move to algebra.group_power>

local infix ^ := monoid.pow

def powers {α : Type u} [monoid α] (x : α) : set α := {y | ∃ n, x^n = y}

instance powers.is_submonoid {α : Type u} [monoid α] (x : α)  : is_submonoid α (powers x) :=
{ one_mem := ⟨0, by simp⟩,
  mul_mem := λ x₁ x₂ ⟨n₁, hn₁⟩ ⟨n₂, hn₂⟩, ⟨n₁ + n₂, by simp [pow_add, *]⟩ }

-- </move>

-- <move to algebra.ring>

def nonunits (α : Type u) [comm_ring α] : set α := { x | ¬∃ y, y * x = 1 }

class is_ring_hom {α : Type u} {β : Type v} [comm_ring α] [comm_ring β] (f : α → β) : Prop :=
(map_add : ∀ {x y}, f (x + y) = f x + f y)
(map_mul : ∀ {x y}, f (x * y) = f x * f y)
(map_one : f 1 = 1)

namespace is_ring_hom

variables {α : Type u} {β : Type v} [comm_ring α] [comm_ring β]
variables (f : α → β) [is_ring_hom f] {x y : α}

lemma map_zero : f 0 = 0 :=
calc f 0 = f (0 + 0) - f 0 : by rw [map_add f]; simp
     ... = 0 : by simp

lemma map_neg : f (-x) = -f x :=
calc f (-x) = f (-x + x) - f x : by rw [map_add f]; simp
        ... = -f x : by simp [map_zero f]

lemma map_sub : f (x - y) = f x - f y :=
by simp [map_add f, map_neg f]

end is_ring_hom

theorem is_submodule.eq_univ_of_contains_unit {α : Type u} [comm_ring α] (S : set α) [is_submodule S]
(x y : α) (hx : x ∈ S) (h : y * x = 1) : S = set.univ :=
set.ext $ λ z, ⟨λ hz, trivial, λ hz, calc
    z = z * (y * x) : by simp [h]
  ... = (z * y) * x : eq.symm $ mul_assoc z y x
  ... ∈ S : is_submodule.smul (z * y) hx⟩

theorem is_submodule.univ_of_one_mem {α : Type u} [comm_ring α] (S : set α) [is_submodule S] :
(1:α) ∈ S → S = set.univ :=
λ h, set.ext $ λ z, ⟨λ hz, trivial, λ hz, by simpa using (is_submodule.smul z h : z * 1 ∈ S)⟩

-- </move>

-- <move to ring_theory.ideals>

class is_ideal {α : Type u} [comm_ring α] (S : set α) extends is_submodule S : Prop

class is_proper_ideal {α : Type u} [comm_ring α] (S : set α) extends is_ideal S : Prop :=
(ne_univ : S ≠ set.univ)

class is_prime_ideal {α : Type u} [comm_ring α] (S : set α) extends is_proper_ideal S : Prop :=
(mem_or_mem_of_mul_mem : ∀ {x y : α}, x * y ∈ S → x ∈ S ∨ y ∈ S)

theorem mem_or_mem_of_mul_eq_zero {α : Type u} [comm_ring α] (S : set α) [is_prime_ideal S] :
  ∀ {x y : α}, x * y = 0 → x ∈ S ∨ y ∈ S :=
λ x y hxy, have x * y ∈ S, by rw hxy; from (@is_submodule.zero α α _ _ S _ : (0:α) ∈ S),
is_prime_ideal.mem_or_mem_of_mul_mem this

class is_maximal_ideal {α : Type u} [comm_ring α] (S : set α) extends is_proper_ideal S : Prop :=
mk' ::
  (eq_or_univ_of_subset : ∀ (T : set α) [is_submodule T], S ⊆ T → T = S ∨ T = set.univ)

theorem is_maximal_ideal.mk {α : Type u} [comm_ring α] (S : set α) [is_submodule S] :
  (1:α) ∉ S → (∀ x (T : set α) [is_submodule T], S ⊆ T → x ∉ S → x ∈ T → (1:α) ∈ T) → is_maximal_ideal S :=
λ h₁ h₂,
{ ne_univ := λ hu, have (1:α) ∈ S, by rw hu; trivial, h₁ this,
  eq_or_univ_of_subset := λ T ht hst, or.cases_on (classical.em $ ∃ x, x ∉ S ∧ x ∈ T)
    (λ ⟨x, hxns, hxt⟩, or.inr $ @@is_submodule.univ_of_one_mem _ T ht $ @@h₂ x T ht hst hxns hxt)
    (λ hnts, or.inl $ set.ext $ λ x,
       ⟨λ hxt, classical.by_contradiction $ λ hxns, hnts ⟨x, hxns, hxt⟩,
        λ hxs, hst hxs⟩) }

theorem not_unit_of_mem_maximal_ideal {α : Type u} [comm_ring α] (S : set α) [is_maximal_ideal S] : S ⊆ nonunits α :=
λ x hx ⟨y, hxy⟩, is_proper_ideal.ne_univ S $ is_submodule.eq_univ_of_contains_unit S x y hx hxy

class local_ring (α : Type u) [comm_ring α] :=
(S : set α)
(max : is_maximal_ideal S)
(unique : ∀ T [is_maximal_ideal T], S = T)

def local_of_nonunits_ideal {α : Type u} [comm_ring α] : (0:α) ≠ 1 → (∀ x y ∈ nonunits α, x + y ∈ nonunits α) → local_ring α :=
λ hnze h, have hi : is_submodule (nonunits α), from
{ zero_ := λ ⟨y, hy⟩, hnze $ by simpa using hy,
  add_  := h,
  smul  := λ x y hy ⟨z, hz⟩, hy ⟨x * z, by rw [← hz]; simp [mul_left_comm, mul_assoc]⟩ },
{ S := nonunits α,
  max := @@is_maximal_ideal.mk _ (nonunits α) hi (λ ho, ho ⟨1, mul_one 1⟩) $
    λ x T ht hst hxns hxt, have hxu : _, from classical.by_contradiction hxns,
    let ⟨y, hxy⟩ := hxu in by rw [← hxy]; exact is_submodule.smul y hxt,
  unique := λ T hmt, or.cases_on (@@is_maximal_ideal.eq_or_univ_of_subset _ hmt (nonunits α) hi $
      λ z hz, @@not_unit_of_mem_maximal_ideal _ T hmt hz) id $
    (λ htu, false.elim $ ((set.set_eq_def _ _).1 htu 1).2 trivial ⟨1, mul_one 1⟩) }

-- </move>

-- <move to data.quot>

@[simp] lemma quotient.lift_beta {α : Sort u} {β : Sort v} [s : setoid α] (f : α → β) (h : ∀ (a b : α), a ≈ b → f a = f b) (x : α):
quotient.lift f h (quotient.mk x) = f x := rfl

@[simp] lemma quotient.lift_on_beta {α : Sort u} {β : Sort v} [s : setoid α] (f : α → β) (h : ∀ (a b : α), a ≈ b → f a = f b) (x : α):
quotient.lift_on (quotient.mk x) f h = f x := rfl

-- </move>
-- </migrations>

namespace localization

variables (α : Type u) [comm_ring α] (S : set α) [is_submonoid α S]

def r : α × S → α × S → Prop :=
λ ⟨r₁, s₁, hs₁⟩ ⟨r₂, s₂, hs₂⟩, ∃ t ∈ S, (s₁ * r₂ - s₂ * r₁) * t = 0

local infix ≈ := r α S

theorem refl : ∀ (x : α × S), x ≈ x :=
λ ⟨r₁, s₁, hs₁⟩, ⟨1, is_submonoid.one_mem S, by simp⟩

theorem symm : ∀ (x y : α × S), x ≈ y → y ≈ x :=
λ ⟨r₁, s₁, hs₁⟩ ⟨r₂, s₂, hs₂⟩ ⟨t, hts, ht⟩, ⟨t, hts, calc
        (s₂ * r₁ - s₁ * r₂) * t
      = -((s₁ * r₂ - s₂ * r₁) * t) : by simp [add_mul]
  ... = 0 : by rw ht; simp⟩

theorem trans : ∀ (x y z : α × S), x ≈ y → y ≈ z → x ≈ z :=
λ ⟨r₁, s₁, hs₁⟩ ⟨r₂, s₂, hs₂⟩ ⟨r₃, s₃, hs₃⟩ ⟨t, hts, ht⟩ ⟨t', hts', ht'⟩,
⟨s₂ * t' * t, is_submonoid.mul_mem (is_submonoid.mul_mem hs₂ hts') hts, calc
         (s₁ * r₃ - s₃ * r₁) * (s₂ * t' * t)
       = t' * s₃ * ((s₁ * r₂ - s₂ * r₁) * t) + t * s₁ * ((s₂ * r₃ - s₃ * r₂) * t') :
           by simp [mul_left_comm, mul_add, mul_comm]
   ... = 0 : by rw [ht, ht']; simp⟩

instance : setoid (α × S) :=
⟨r α S, refl α S, symm α S, trans α S⟩

def loc := quotient $ localization.setoid α S

private def add_aux : α × S → α × S → loc α S :=
λ ⟨r₁, s₁, hs₁⟩ ⟨r₂, s₂, hs₂⟩, ⟦⟨s₁ * r₂ + s₂ * r₁, s₁ * s₂, is_submonoid.mul_mem hs₁ hs₂⟩⟧

instance : has_add (loc α S) :=
⟨quotient.lift₂ (add_aux α S) $
 λ ⟨r₁, s₁, hs₁⟩ ⟨r₂, s₂, hs₂⟩ ⟨r₃, s₃, hs₃⟩ ⟨r₄, s₄, hs₄⟩ ⟨t₅, hts₅, ht₅⟩ ⟨t₆, hts₆, ht₆⟩,
 quotient.sound ⟨t₆ * t₅, is_submonoid.mul_mem hts₆ hts₅, calc
         (s₁ * s₂ * (s₃ * r₄ + s₄ * r₃) - s₃ * s₄ * (s₁ * r₂ + s₂ * r₁)) * (t₆ * t₅)
       = s₁ * s₃ * ((s₂ * r₄ - s₄ * r₂) * t₆) * t₅ + s₂ * s₄ * ((s₁ * r₃ - s₃ * r₁) * t₅) * t₆ : by ring
   ... = 0 : by rw [ht₆, ht₅]; simp⟩⟩

private def neg_aux : α × S → loc α S :=
λ ⟨r, s, hs⟩, ⟦⟨-r, s, hs⟩⟧

instance : has_neg (loc α S) :=
⟨quotient.lift (neg_aux α S) $
 λ ⟨r₁, s₁, hs₁⟩ ⟨r₂, s₂, hs₂⟩ ⟨t, hts, ht⟩,
 quotient.sound ⟨t, hts, calc
         (s₁ * -r₂ - s₂ * -r₁) * t
       = -((s₁ * r₂ - s₂ * r₁) * t) : by ring
   ... = 0 : by rw ht; simp⟩⟩

private def mul_aux : α × S → α × S → loc α S :=
λ ⟨r₁, s₁, hs₁⟩ ⟨r₂, s₂, hs₂⟩, ⟦⟨r₁ * r₂, s₁ * s₂, is_submonoid.mul_mem hs₁ hs₂⟩⟧

instance : has_mul (loc α S) :=
⟨quotient.lift₂ (mul_aux α S) $
 λ ⟨r₁, s₁, hs₁⟩ ⟨r₂, s₂, hs₂⟩ ⟨r₃, s₃, hs₃⟩ ⟨r₄, s₄, hs₄⟩ ⟨t₅, hts₅, ht₅⟩ ⟨t₆, hts₆, ht₆⟩,
 quotient.sound ⟨t₆ * t₅, is_submonoid.mul_mem hts₆ hts₅, calc
         ((s₁ * s₂) * (r₃ * r₄) - (s₃ * s₄) * (r₁ * r₂)) * (t₆ * t₅)
       = t₆ * ((s₁ * r₃ - s₃ * r₁) * t₅) * r₂ * s₄ + t₅ * ((s₂ * r₄ - s₄ * r₂) * t₆) * r₃ * s₁ : by simp [mul_left_comm, mul_add, mul_comm]
   ... = 0 : by rw [ht₅, ht₆]; simp⟩⟩

instance : comm_ring (loc α S) :=
by refine
{ add            := has_add.add,
  add_assoc      := λ m n k, quotient.induction_on₃ m n k _,
  zero           := ⟦⟨0, 1, is_submonoid.one_mem S⟩⟧,
  zero_add       := quotient.ind _,
  add_zero       := quotient.ind _,
  neg            := has_neg.neg,
  add_left_neg   := quotient.ind _,
  add_comm       := quotient.ind₂ _,
  mul            := has_mul.mul,
  mul_assoc      := λ m n k, quotient.induction_on₃ m n k _,
  one            := ⟦⟨1, 1, is_submonoid.one_mem S⟩⟧,
  one_mul        := quotient.ind _,
  mul_one        := quotient.ind _,
  left_distrib   := λ m n k, quotient.induction_on₃ m n k _,
  right_distrib  := λ m n k, quotient.induction_on₃ m n k _,
  mul_comm       := quotient.ind₂ _ };
{ intros,
  try {cases a with r₁ s₁, cases s₁ with s₁ hs₁},
  try {cases b with r₂ s₂, cases s₂ with s₂ hs₂},
  try {cases c with r₃ s₃, cases s₃ with s₃ hs₃},
  apply quotient.sound,
  existsi (1:α),
  existsi is_submonoid.one_mem S,
  simp [mul_left_comm, mul_add, mul_comm] }

def of_comm_ring : α → loc α S :=
λ r, ⟦⟨r, 1, is_submonoid.one_mem S⟩⟧

instance : is_ring_hom (of_comm_ring α S) :=
{ map_add := λ x y, quotient.sound $ by simp,
  map_mul := λ x y, quotient.sound $ by simp,
  map_one := rfl }

local infix ^ := monoid.pow

variable {α}

def away (x : α) := loc α (powers x)

instance away.comm_ring (x : α) : comm_ring (away x) :=
localization.comm_ring α (powers x)

section at_prime

variables (P : set α) [is_prime_ideal P]

instance prime.is_submonoid :
  is_submonoid α (set.compl P) :=
{ one_mem := λ h, is_proper_ideal.ne_univ P $
    is_submodule.univ_of_one_mem P h,
  mul_mem := λ x y hnx hny hxy, or.cases_on
    (is_prime_ideal.mem_or_mem_of_mul_mem hxy) hnx hny }

def at_prime := loc α (set.compl P)

instance at_prime.comm_ring : comm_ring (at_prime P) :=
localization.comm_ring α (set.compl P)

instance at_prime.local_ring : local_ring (at_prime P) :=
local_of_nonunits_ideal
  (λ hze, have _, from quotient.exact hze, let ⟨t, hts, ht⟩ := this in
     hts $ have htz : t = 0, by simpa using ht,
       suffices (0:α) ∈ P, by rwa htz,
       @is_submodule.zero _ _ _ _ P _)
  (λ x y hx hy ⟨z, hz⟩,
     let ⟨⟨r₁, s₁, hs₁⟩, hrs₁⟩ := quotient.exists_rep x,
         ⟨⟨r₂, s₂, hs₂⟩, hrs₂⟩ := quotient.exists_rep y,
         ⟨⟨r₃, s₃, hs₃⟩, hrs₃⟩ := quotient.exists_rep z in
     have _, by rw [← hrs₁, ← hrs₂, ← hrs₃] at hz; from quotient.exact hz,
     let ⟨t, hts, ht⟩ := this in
     have hr₁ : r₁ ∈ P, from classical.by_contradiction $
     λ hnr₁, hx ⟨⟦⟨s₁, r₁, hnr₁⟩⟧, by rw ←hrs₁;
       from quotient.sound ⟨1, is_submonoid.one_mem _, by simp [mul_comm]⟩⟩,
     have hr₂ : r₂ ∈ P, from classical.by_contradiction $
     λ hnr₂, hy ⟨⟦⟨s₂, r₂, hnr₂⟩⟧, by rw ←hrs₂;
       from quotient.sound ⟨1, is_submonoid.one_mem _, by simp [mul_comm]⟩⟩,
     have hr₃ : _ , from or.resolve_right
     (mem_or_mem_of_mul_eq_zero P ht) hts,
     have h : s₃ * (s₁ * s₂) - r₃ * (s₁ * r₂ + s₂ * r₁) ∈ P,
     by simpa using hr₃,
     have h1 : r₃ * (s₁ * r₂ + s₂ * r₁) ∈ P,
     from is_submodule.smul r₃ $ is_submodule.add
         (is_submodule.smul s₁ hr₂)
         (is_submodule.smul s₂ hr₁),
     have h2 : s₃ * (s₁ * s₂) ∈ P,
     from calc s₃ * (s₁ * s₂)
           = s₃ * (s₁ * s₂) - r₃ * (s₁ * r₂ + s₂ * r₁) + r₃ * (s₁ * r₂ + s₂ * r₁) : eq.symm $ sub_add_cancel _ _
       ... ∈ P : is_submodule.add h h1,
     have h3 : s₁ * s₂ ∈ P, from or.resolve_left
     (is_prime_ideal.mem_or_mem_of_mul_mem h2) hs₃,
     or.cases_on (is_prime_ideal.mem_or_mem_of_mul_mem h3) hs₁ hs₂)

end at_prime

inductive in_closure (S : set α) : α → Prop
| basic : ∀a∈S, in_closure a
| one : in_closure 1
| mul : ∀x y, in_closure x → in_closure y → in_closure (x * y)

def closure (S : set α) : set α := {x | in_closure S x}

instance closure.is_submonoid (S : set α) : is_submonoid α (closure S) :=
{ one_mem := in_closure.one S, mul_mem := in_closure.mul }

theorem subset_closure {S : set α} : S ⊆ closure S :=
in_closure.basic

variable α

def non_zero_divisors : set α := {x | ∀ z, z * x = 0 → z = 0}

instance non_zero_divisors.is_submonoid : is_submonoid α (non_zero_divisors α) :=
{ one_mem := λ z hz, by simpa using hz,
  mul_mem := λ x₁ x₂ hx₁ hx₂ z hz,
    have z * x₁ * x₂ = 0,
    by rwa mul_assoc,
    hx₁ z $ hx₂ (z * x₁) this }

def quotient_ring := loc α (non_zero_divisors α)

instance quotient_ring.comm_ring : comm_ring (quotient_ring α) :=
localization.comm_ring α (non_zero_divisors α)

section quotient_ring

variables {β : Type u} [integral_domain β] [decidable_eq β]

lemma ne_zero_of_mem_non_zero_divisors {x : β} :
  x ∈ localization.non_zero_divisors β → x ≠ 0 :=
λ hm hz, have 1 * x = 0, by simp [hz], zero_ne_one (hm 1 this).symm

lemma eq_zero_of_ne_zero_of_mul_eq_zero {x y : β} :
  x ≠ 0 → y * x = 0 → y = 0 :=
λ hnx hxy, or.resolve_right (eq_zero_or_eq_zero_of_mul_eq_zero hxy) hnx

lemma mem_non_zero_divisors_of_ne_zero {x : β} :
  x ≠ 0 → x ∈ localization.non_zero_divisors β :=
λ hnx z, eq_zero_of_ne_zero_of_mul_eq_zero hnx

variable β

private def inv_aux : β × (non_zero_divisors β) → quotient_ring β :=
λ ⟨r, s, hs⟩, if h : r = 0 then
  ⟦⟨0, 1, is_submonoid.one_mem _⟩⟧
else ⟦⟨s, r, mem_non_zero_divisors_of_ne_zero h⟩⟧

instance : has_inv (quotient_ring β) :=
⟨quotient.lift (inv_aux β) $
 λ ⟨r₁, s₁, hs₁⟩ ⟨r₂, s₂, hs₂⟩ ⟨t, hts, ht⟩,
 begin
   have hrs : s₁ * r₂ - s₂ * r₁ = 0,
   { from hts _ ht },
   by_cases hr₁ : r₁ = 0;
   by_cases hr₂ : r₂ = 0;
   simp [inv_aux, hr₁, hr₂],
   { exfalso,
     simp [hr₁] at hrs,
     exact ne_zero_of_mem_non_zero_divisors hs₁
       (eq_zero_of_ne_zero_of_mul_eq_zero hr₂ hrs) },
   { exfalso,
     simp [hr₂] at hrs,
     exact ne_zero_of_mem_non_zero_divisors hs₂
       (eq_zero_of_ne_zero_of_mul_eq_zero hr₁ hrs) },
   { exact ⟨1, is_submonoid.one_mem _,
     by simpa [mul_comm] using congr_arg (λ x, -x) hrs⟩ }
 end⟩

def quotient_ring.field.of_integral_domain : field (quotient_ring β) :=
by refine
{ inv := has_inv.inv,
  zero_ne_one := λ hzo, let ⟨t, hts, ht⟩ := quotient.exact hzo in
    zero_ne_one (by simpa using hts _ ht : 0 = 1),
  mul_inv_cancel := quotient.ind _,
  inv_mul_cancel := quotient.ind _,
  ..localization.comm_ring β _ };
{ intros x hnx,
  cases x with x hx,
  cases hx with z hz,
  have : x ≠ 0,
    intro hx,
    apply hnx,
    apply quotient.sound,
    existsi (1:β),
    existsi is_submonoid.one_mem _,
    simp [hx],
    exact non_zero_divisors.is_submonoid β,
  simp [has_inv.inv, inv_aux, inv_aux._match_1],
  rw dif_neg this,
  apply quotient.sound,
  existsi (1:β),
  existsi is_submonoid.one_mem _,
  ring,
  exact non_zero_divisors.is_submonoid β }

end quotient_ring

end localization

-- Factoids (not to go to mathlib):

instance : add_comm_group int := ring.to_add_comm_group int
instance : add_group int := by apply_instance

def frac_int_to_rat : localization.quotient_ring ℤ → ℚ :=
λ f, quotient.lift_on f (λ ⟨r, s, hs⟩, rat.mk r s) $
λ ⟨r₁, s₁, hs₁⟩ ⟨r₂, s₂, hs₂⟩ ⟨t, hts, ht⟩,
have hsnz₁ : s₁ ≠ 0,
from localization.ne_zero_of_mem_non_zero_divisors hs₁,
have hsnz₂ : s₂ ≠ 0,
from localization.ne_zero_of_mem_non_zero_divisors hs₂,
have htnz : t ≠ 0,
from localization.ne_zero_of_mem_non_zero_divisors hts,
begin
  cases eq_zero_or_eq_zero_of_mul_eq_zero ht with hrs htz,
  { change rat.mk r₁ s₁ = rat.mk r₂ s₂,
    rw sub_eq_zero at hrs,
    rw rat.mk_eq hsnz₁ hsnz₂,
    simp only [mul_comm, hrs] },
  {  exfalso,
     exact htnz htz }
end

lemma coe_denom_ne_zero (r : ℚ) : (↑r.denom:ℤ) ≠ 0 :=
λ hn, ne_of_gt r.pos $ int.of_nat_inj hn

def frac_int_of_rat : ℚ → localization.quotient_ring ℤ :=
λ r, ⟦⟨r.num, r.denom, λ z hz,
or.cases_on (eq_zero_or_eq_zero_of_mul_eq_zero hz) id
  (λ hz, false.elim $ coe_denom_ne_zero r hz)⟩⟧

theorem frac_int_to_rat_to_frac_int : ∀ f, frac_int_of_rat (frac_int_to_rat f) = f :=
λ f, quotient.induction_on f $ λ ⟨r, s, hs⟩, quotient.sound
⟨1, is_submonoid.one_mem _,
   suffices r * ↑(rat.mk r s).denom = (rat.mk r s).num * s,
   from show (↑(rat.mk r s).denom * r - s * (rat.mk r s).num) * 1 = 0,
     by simp [mul_comm, this],
   have hnd : (↑(rat.mk r s).denom:ℤ) ≠ 0,
     from coe_denom_ne_zero $ rat.mk r s,
   have hns : s ≠ 0,
     from localization.ne_zero_of_mem_non_zero_divisors hs,
   have _, from rat.num_denom $ rat.mk r s,
   by rwa ← rat.mk_eq hns hnd ⟩

theorem rat_to_frac_int_to_rat : ∀ r, frac_int_to_rat (frac_int_of_rat r) = r :=
λ ⟨n, d, h, c⟩, eq.symm $ rat.num_denom _

def canonical : equiv (localization.quotient_ring ℤ) (ℚ) :=
⟨frac_int_to_rat, frac_int_of_rat,
   frac_int_to_rat_to_frac_int,
   rat_to_frac_int_to_rat⟩

def dyadic_rat := localization.away (2:ℤ)


/-
Copyright (c) 2020 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin
-/
import algebra.group_power

/-!
# Powers of elements of groups with an adjoined zero element

In this file we define integer power functions for groups with an adjoined zero element.
This generalises the integer power function on a division ring.
-/

section zero
variables {M : Type*} [monoid_with_zero M]

@[simp] lemma zero_pow' : ∀ n : ℕ, n ≠ 0 → (0 : M) ^ n = 0
| 0     h := absurd rfl h
| (k+1) h := by { rw [pow_succ], exact zero_mul _ }

lemma ne_zero_pow {a : M} {n : ℕ} (hn : n ≠ 0) : a ^ n ≠ 0 → a ≠ 0 :=
by { contrapose!, rintro rfl, exact zero_pow' n hn }

@[simp] lemma zero_pow_eq_zero [nontrivial M] {n : ℕ} : (0 : M) ^ n = 0 ↔ 0 < n :=
begin
  split; intro h,
  { rw [pos_iff_ne_zero], rintro rfl, simpa using h },
  { exact zero_pow' n h.ne.symm }
end

end zero

section group_with_zero
variables {G₀ : Type*} [group_with_zero G₀]

section nat_pow

@[simp, field_simps] theorem inv_pow' (a : G₀) (n : ℕ) : (a⁻¹) ^ n = (a ^ n)⁻¹ :=
begin
  induction n with n ih,
  { rw [pow_zero, pow_zero], exact inv_one.symm },
  { rw [pow_succ', pow_succ, ih, mul_inv_rev'] }
end

theorem pow_sub' (a : G₀) {m n : ℕ} (ha : a ≠ 0) (h : n ≤ m) : a ^ (m - n) = a ^ m * (a ^ n)⁻¹ :=
have h1 : m - n + n = m, from nat.sub_add_cancel h,
have h2 : a ^ (m - n) * a ^ n = a ^ m, by rw [←pow_add, h1],
by simpa only [div_eq_mul_inv] using eq_div_of_mul_eq (pow_ne_zero _ ha) h2

theorem pow_inv_comm' (a : G₀) (m n : ℕ) : (a⁻¹) ^ m * a ^ n = a ^ n * (a⁻¹) ^ m :=
(commute.refl a).inv_left'.pow_pow m n

end nat_pow

end group_with_zero

section int_pow
open int
variables {G₀ : Type*} [group_with_zero G₀]

local attribute [ematch] le_of_lt

@[simp] theorem one_fpow : ∀ (n : ℤ), (1 : G₀) ^ n = 1
| (n : ℕ) := by rw [gpow_coe_nat, one_pow]
| -[1+ n] := by rw [gpow_neg_succ_of_nat, one_pow, inv_one]

lemma zero_fpow : ∀ z : ℤ, z ≠ 0 → (0 : G₀) ^ z = 0
| (n : ℕ) h := by { rw [gpow_coe_nat, zero_pow'], simpa using h }
| -[1+n]  h := by simp

lemma fzero_pow_eq (n : ℤ) : (0 : G₀) ^ n = if n = 0 then 1 else 0 :=
begin
  split_ifs with h,
  { rw [h, gpow_zero] },
  { rw [zero_fpow _ h] }
end

@[simp] theorem fpow_neg (a : G₀) : ∀ (n : ℤ), a ^ -n = (a ^ n)⁻¹
| (n+1:ℕ) := div_inv_monoid.gpow_neg' _ _
| 0       := by { change a ^ (0 : ℤ) = (a ^ (0 : ℤ))⁻¹, simp }
| -[1+ n] := by { rw [gpow_neg_succ_of_nat, inv_inv', ← gpow_coe_nat], refl }

theorem fpow_neg_one (x : G₀) : x ^ (-1:ℤ) = x⁻¹ :=
by { rw [← congr_arg has_inv.inv (pow_one x), fpow_neg, ← gpow_coe_nat], refl }

theorem inv_fpow (a : G₀) : ∀n:ℤ, a⁻¹ ^ n = (a ^ n)⁻¹
| (n : ℕ) := by rw [gpow_coe_nat, gpow_coe_nat, inv_pow']
| -[1+ n] := by rw [gpow_neg_succ_of_nat, gpow_neg_succ_of_nat, inv_pow']

lemma fpow_add_one {a : G₀} (ha : a ≠ 0) : ∀ n : ℤ, a ^ (n + 1) = a ^ n * a
| (n : ℕ)    := by simp [← int.coe_nat_succ, pow_succ']
| -[1+0]     := by simp [int.neg_succ_of_nat_eq, ha]
| -[1+(n+1)] := by rw [int.neg_succ_of_nat_eq, fpow_neg, neg_add, neg_add_cancel_right, fpow_neg,
  ← int.coe_nat_succ, gpow_coe_nat, gpow_coe_nat, pow_succ _ (n + 1), mul_inv_rev', mul_assoc,
  inv_mul_cancel ha, mul_one]

lemma fpow_sub_one {a : G₀} (ha : a ≠ 0) (n : ℤ) : a ^ (n - 1) = a ^ n * a⁻¹ :=
calc a ^ (n - 1) = a ^ (n - 1) * a * a⁻¹ : by rw [mul_assoc, mul_inv_cancel ha, mul_one]
             ... = a^n * a⁻¹             : by rw [← fpow_add_one ha, sub_add_cancel]

lemma fpow_add {a : G₀} (ha : a ≠ 0) (m n : ℤ) : a ^ (m + n) = a ^ m * a ^ n :=
begin
  induction n using int.induction_on with n ihn n ihn,
  case hz : { simp },
  { simp only [← add_assoc, fpow_add_one ha, ihn, mul_assoc] },
  { rw [fpow_sub_one ha, ← mul_assoc, ← ihn, ← fpow_sub_one ha, add_sub_assoc] }
end

lemma fpow_add' {a : G₀} {m n : ℤ} (h : a ≠ 0 ∨ m + n ≠ 0 ∨ m = 0 ∧ n = 0) :
  a ^ (m + n) = a ^ m * a ^ n :=
begin
  by_cases hm : m = 0, { simp [hm] },
  by_cases hn : n = 0, { simp [hn] },
  by_cases ha : a = 0,
  { subst a,
    simp only [false_or, eq_self_iff_true, not_true, ne.def, hm, hn, false_and, or_false] at h,
    rw [zero_fpow _ h, zero_fpow _ hm, zero_mul] },
  { exact fpow_add ha m n }
end

theorem fpow_one_add {a : G₀} (h : a ≠ 0) (i : ℤ) : a ^ (1 + i) = a * a ^ i :=
by rw [fpow_add h, gpow_one]

theorem semiconj_by.fpow_right {a x y : G₀} (h : semiconj_by a x y) :
  ∀ m : ℤ, semiconj_by a (x^m) (y^m)
| (n : ℕ) := by simp [h.pow_right n]
| -[1+n]  := by simp [(h.pow_right (n + 1)).inv_right']

theorem commute.fpow_right {a b : G₀} (h : commute a b) : ∀ m : ℤ, commute a (b^m) :=
h.fpow_right

theorem commute.fpow_left {a b : G₀} (h : commute a b) (m : ℤ) : commute (a^m) b :=
(h.symm.fpow_right m).symm

theorem commute.fpow_fpow {a b : G₀} (h : commute a b) (m n : ℤ) : commute (a^m) (b^n) :=
(h.fpow_left m).fpow_right n

theorem commute.fpow_self (a : G₀) (n : ℤ) : commute (a^n) a := (commute.refl a).fpow_left n

theorem commute.self_fpow (a : G₀) (n : ℤ) : commute a (a^n) := (commute.refl a).fpow_right n

theorem commute.fpow_fpow_self (a : G₀) (m n : ℤ) : commute (a^m) (a^n) :=
(commute.refl a).fpow_fpow m n

theorem fpow_bit0 (a : G₀) (n : ℤ) : a ^ bit0 n = a ^ n * a ^ n :=
begin
  apply fpow_add', right,
  by_cases hn : n = 0,
  { simp [hn] },
  { simp [← two_mul, hn, two_ne_zero] }
end

theorem fpow_bit1 (a : G₀) (n : ℤ) : a ^ bit1 n = a ^ n * a ^ n * a :=
begin
  rw [← fpow_bit0, bit1, fpow_add', gpow_one],
  right, left,
  apply bit1_ne_zero
end

theorem fpow_mul (a : G₀) : ∀ m n : ℤ, a ^ (m * n) = (a ^ m) ^ n
| (m : ℕ) (n : ℕ) := by { rw [gpow_coe_nat, gpow_coe_nat, ← pow_mul, ← gpow_coe_nat], refl }
| (m : ℕ) -[1+ n] := by { rw [gpow_coe_nat, gpow_neg_succ_of_nat, ← pow_mul, coe_nat_mul_neg_succ,
    fpow_neg, inv_inj', ← gpow_coe_nat], refl }
| -[1+ m] (n : ℕ) := by { rw [gpow_coe_nat, gpow_neg_succ_of_nat, ← inv_pow', ← pow_mul,
    neg_succ_mul_coe_nat, fpow_neg, inv_pow', inv_inj', ← gpow_coe_nat], refl }
| -[1+ m] -[1+ n] := by { rw [gpow_neg_succ_of_nat, gpow_neg_succ_of_nat, neg_succ_mul_neg_succ,
    inv_pow', inv_inv', ← pow_mul, ← gpow_coe_nat], refl }

theorem fpow_mul' (a : G₀) (m n : ℤ) : a ^ (m * n) = (a ^ n) ^ m :=
by rw [mul_comm, fpow_mul]

@[simp, norm_cast] lemma units.coe_gpow' (u : units G₀) :
  ∀ (n : ℤ), ((u ^ n : units G₀) : G₀) = u ^ n
| (n : ℕ) := by { rw [gpow_coe_nat, gpow_coe_nat], exact u.coe_pow n }
| -[1+k] := by rw [gpow_neg_succ_of_nat, gpow_neg_succ_of_nat, units.coe_inv', u.coe_pow]

lemma fpow_ne_zero_of_ne_zero {a : G₀} (ha : a ≠ 0) : ∀ (z : ℤ), a ^ z ≠ 0
| (n : ℕ) := by { rw gpow_coe_nat, exact pow_ne_zero _ ha }
| -[1+n]  := by { rw gpow_neg_succ_of_nat, exact inv_ne_zero (pow_ne_zero _ ha) }

lemma fpow_sub {a : G₀} (ha : a ≠ 0) (z1 z2 : ℤ) : a ^ (z1 - z2) = a ^ z1 / a ^ z2 :=
by rw [sub_eq_add_neg, fpow_add ha, fpow_neg, div_eq_mul_inv]

lemma commute.mul_fpow {a b : G₀} (h : commute a b) :
  ∀ (i : ℤ), (a * b) ^ i = (a ^ i) * (b ^ i)
| (n : ℕ) := by simp [h.mul_pow n]
| -[1+n]  := by simp [h.mul_pow, (h.pow_pow _ _).eq, mul_inv_rev']

lemma mul_fpow {G₀ : Type*} [comm_group_with_zero G₀] (a b : G₀) (m : ℤ):
  (a * b) ^ m = (a ^ m) * (b ^ m) :=
(commute.all a b).mul_fpow m

theorem fpow_bit0' (a : G₀) (n : ℤ) : a ^ bit0 n = (a * a) ^ n :=
(fpow_bit0 a n).trans ((commute.refl a).mul_fpow n).symm

theorem fpow_bit1' (a : G₀) (n : ℤ) : a ^ bit1 n = (a * a) ^ n * a :=
by rw [fpow_bit1, (commute.refl a).mul_fpow]

lemma fpow_eq_zero {x : G₀} {n : ℤ} (h : x ^ n = 0) : x = 0 :=
classical.by_contradiction $ λ hx, fpow_ne_zero_of_ne_zero hx n h

lemma fpow_ne_zero {x : G₀} (n : ℤ) : x ≠ 0 → x ^ n ≠ 0 :=
mt fpow_eq_zero

theorem fpow_neg_mul_fpow_self (n : ℤ) {x : G₀} (h : x ≠ 0) :
  x ^ (-n) * x ^ n = 1 :=
begin
  rw [fpow_neg],
  exact inv_mul_cancel (fpow_ne_zero n h)
end

theorem one_div_pow {a : G₀} (n : ℕ) :
  (1 / a) ^ n = 1 / a ^ n :=
by simp only [one_div, inv_pow']

theorem one_div_fpow {a : G₀} (n : ℤ) :
  (1 / a) ^ n = 1 / a ^ n :=
by simp only [one_div, inv_fpow]

@[simp] lemma inv_fpow' {a : G₀} (n : ℤ) :
  (a ⁻¹) ^ n = a ^ (-n) :=
by { rw [inv_fpow, ← fpow_neg_one, ← fpow_mul], simp }

end int_pow

section
variables {G₀ : Type*} [comm_group_with_zero G₀]

@[simp] theorem div_pow (a b : G₀) (n : ℕ) :
  (a / b) ^ n = a ^ n / b ^ n :=
by simp only [div_eq_mul_inv, mul_pow, inv_pow']

@[simp] theorem div_fpow (a : G₀) {b : G₀} (n : ℤ) :
  (a / b) ^ n = a ^ n / b ^ n :=
by simp only [div_eq_mul_inv, mul_fpow, inv_fpow]

lemma div_sq_cancel {a : G₀} (ha : a ≠ 0) (b : G₀) : a ^ 2 * b / a = a * b :=
by rw [sq, mul_assoc, mul_div_cancel_left _ ha]

end

/-- If a monoid homomorphism `f` between two `group_with_zero`s maps `0` to `0`, then it maps `x^n`,
`n : ℤ`, to `(f x)^n`. -/
lemma monoid_with_zero_hom.map_fpow {G₀ G₀' : Type*} [group_with_zero G₀] [group_with_zero G₀']
  (f : monoid_with_zero_hom G₀ G₀') (x : G₀) :
  ∀ n : ℤ, f (x ^ n) = f x ^ n
| (n : ℕ) := by { rw [gpow_coe_nat, gpow_coe_nat], exact f.to_monoid_hom.map_pow x n }
| -[1+n] := begin
    rw [gpow_neg_succ_of_nat, gpow_neg_succ_of_nat],
    exact ((f.map_inv' _).trans $ congr_arg _ $ f.to_monoid_hom.map_pow x _)
  end

-- I haven't been able to find a better home for this:
-- it belongs with other lemmas on `linear_ordered_field`, but
-- we need to wait until `fpow` has been defined in this file.
section
variables {R : Type*} [linear_ordered_field R] {a : R}

lemma pow_minus_two_nonneg : 0 ≤ a^(-2 : ℤ) :=
begin
  simp only [inv_nonneg, fpow_neg],
  change 0 ≤ a ^ ((2 : ℕ) : ℤ),
  rw gpow_coe_nat,
  apply sq_nonneg,
end

end


/-
Copyright (c) 2020 Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bhavik Mehta
-/
import category_theory.limits.shapes.split_coequalizer
import category_theory.limits.preserves.basic

/-!
# Preserving (co)equalizers

Constructions to relate the notions of preserving (co)equalizers and reflecting (co)equalizers
to concrete (co)forks.

In particular, we show that `equalizer_comparison G f` is an isomorphism iff `G` preserves
the limit of `f` as well as the dual.
-/

noncomputable theory

universes v u₁ u₂

open category_theory category_theory.category category_theory.limits

variables {C : Type u₁} [category.{v} C]
variables {D : Type u₂} [category.{v} D]
variables (G : C ⥤ D)

namespace category_theory.limits

section equalizers
variables {X Y Z : C} {f g : X ⟶ Y} {h : Z ⟶ X} (w : h ≫ f = h ≫ g)

/--
The map of a fork is a limit iff the fork consisting of the mapped morphisms is a limit. This
essentially lets us commute `fork.of_ι` with `functor.map_cone`.
-/
def is_limit_map_cone_fork_equiv :
  is_limit (G.map_cone (fork.of_ι h w)) ≃
  is_limit (fork.of_ι (G.map h) (by simp only [←G.map_comp, w]) : fork (G.map f) (G.map g)) :=
(is_limit.postcompose_hom_equiv (diagram_iso_parallel_pair _) _).symm.trans
  (is_limit.equiv_iso_limit (fork.ext (iso.refl _) (by simp)))

/-- The property of preserving equalizers expressed in terms of forks. -/
def is_limit_fork_map_of_is_limit [preserves_limit (parallel_pair f g) G]
  (l : is_limit (fork.of_ι h w)) :
  is_limit (fork.of_ι (G.map h) (by simp only [←G.map_comp, w]) : fork (G.map f) (G.map g)) :=
is_limit_map_cone_fork_equiv G w (preserves_limit.preserves l)

/-- The property of reflecting equalizers expressed in terms of forks. -/
def is_limit_of_is_limit_fork_map [reflects_limit (parallel_pair f g) G]
  (l : is_limit (fork.of_ι (G.map h) (by simp only [←G.map_comp, w]) : fork (G.map f) (G.map g))) :
  is_limit (fork.of_ι h w) :=
reflects_limit.reflects ((is_limit_map_cone_fork_equiv G w).symm l)

variables (f g) [has_equalizer f g]

/--
If `G` preserves equalizers and `C` has them, then the fork constructed of the mapped morphisms of
a fork is a limit.
-/
def is_limit_of_has_equalizer_of_preserves_limit
  [preserves_limit (parallel_pair f g) G] :
  is_limit (fork.of_ι (G.map (equalizer.ι f g))
                      (by simp only [←G.map_comp, equalizer.condition])) :=
is_limit_fork_map_of_is_limit G _ (equalizer_is_equalizer f g)

variables [has_equalizer (G.map f) (G.map g)]

/--
If the equalizer comparison map for `G` at `(f,g)` is an isomorphism, then `G` preserves the
equalizer of `(f,g)`.
-/
def preserves_equalizer.of_iso_comparison [i : is_iso (equalizer_comparison f g G)] :
  preserves_limit (parallel_pair f g) G :=
begin
  apply preserves_limit_of_preserves_limit_cone (equalizer_is_equalizer f g),
  apply (is_limit_map_cone_fork_equiv _ _).symm _,
  apply is_limit.of_point_iso (limit.is_limit (parallel_pair (G.map f) (G.map g))),
  apply i,
end

variables [preserves_limit (parallel_pair f g) G]
/--
If `G` preserves the equalizer of `(f,g)`, then the equalizer comparison map for `G` at `(f,g)` is
an isomorphism.
-/
def preserves_equalizer.iso :
  G.obj (equalizer f g) ≅ equalizer (G.map f) (G.map g) :=
is_limit.cone_point_unique_up_to_iso
  (is_limit_of_has_equalizer_of_preserves_limit G f g)
  (limit.is_limit _)

@[simp]
lemma preserves_equalizer.iso_hom :
  (preserves_equalizer.iso G f g).hom = equalizer_comparison f g G :=
rfl

instance : is_iso (equalizer_comparison f g G) :=
begin
  rw ← preserves_equalizer.iso_hom,
  apply_instance
end

end equalizers

section coequalizers

variables {X Y Z : C} {f g : X ⟶ Y} {h : Y ⟶ Z} (w : f ≫ h = g ≫ h)

/--
The map of a cofork is a colimit iff the cofork consisting of the mapped morphisms is a colimit.
This essentially lets us commute `cofork.of_π` with `functor.map_cocone`.
-/
def is_colimit_map_cocone_cofork_equiv :
  is_colimit (G.map_cocone (cofork.of_π h w)) ≃
  is_colimit (cofork.of_π (G.map h) (by simp only [←G.map_comp, w]) : cofork (G.map f) (G.map g)) :=
(is_colimit.precompose_inv_equiv (diagram_iso_parallel_pair _) _).symm.trans
  (is_colimit.equiv_iso_colimit (cofork.ext (iso.refl _) (by { dsimp, simp })))

/-- The property of preserving coequalizers expressed in terms of coforks. -/
def is_colimit_cofork_map_of_is_colimit [preserves_colimit (parallel_pair f g) G]
  (l : is_colimit (cofork.of_π h w)) :
  is_colimit (cofork.of_π (G.map h) (by simp only [←G.map_comp, w]) : cofork (G.map f) (G.map g)) :=
is_colimit_map_cocone_cofork_equiv G w (preserves_colimit.preserves l)

/-- The property of reflecting coequalizers expressed in terms of coforks. -/
def is_colimit_of_is_colimit_cofork_map [reflects_colimit (parallel_pair f g) G]
  (l : is_colimit (cofork.of_π (G.map h) (by simp only [←G.map_comp, w])
                  : cofork (G.map f) (G.map g))) :
  is_colimit (cofork.of_π h w) :=
reflects_colimit.reflects ((is_colimit_map_cocone_cofork_equiv G w).symm l)

variables (f g) [has_coequalizer f g]

/--
If `G` preserves coequalizers and `C` has them, then the cofork constructed of the mapped morphisms
of a cofork is a colimit.
-/
def is_colimit_of_has_coequalizer_of_preserves_colimit
  [preserves_colimit (parallel_pair f g) G] :
  is_colimit (cofork.of_π (G.map (coequalizer.π f g)) _) :=
is_colimit_cofork_map_of_is_colimit G _ (coequalizer_is_coequalizer f g)

variables [has_coequalizer (G.map f) (G.map g)]

/--
If the coequalizer comparison map for `G` at `(f,g)` is an isomorphism, then `G` preserves the
coequalizer of `(f,g)`.
-/
def of_iso_comparison [i : is_iso (coequalizer_comparison f g G)] :
  preserves_colimit (parallel_pair f g) G :=
begin
  apply preserves_colimit_of_preserves_colimit_cocone (coequalizer_is_coequalizer f g),
  apply (is_colimit_map_cocone_cofork_equiv _ _).symm _,
  apply is_colimit.of_point_iso (colimit.is_colimit (parallel_pair (G.map f) (G.map g))),
  apply i,
end

variables [preserves_colimit (parallel_pair f g) G]
/--
If `G` preserves the coequalizer of `(f,g)`, then the coequalizer comparison map for `G` at `(f,g)`
is an isomorphism.
-/
def preserves_coequalizer.iso :
  coequalizer (G.map f) (G.map g) ≅ G.obj (coequalizer f g) :=
is_colimit.cocone_point_unique_up_to_iso
  (colimit.is_colimit _)
  (is_colimit_of_has_coequalizer_of_preserves_colimit G f g)

@[simp]
lemma preserves_coequalizer.iso_hom :
  (preserves_coequalizer.iso G f g).hom = coequalizer_comparison f g G :=
rfl

instance : is_iso (coequalizer_comparison f g G) :=
begin
  rw ← preserves_coequalizer.iso_hom,
  apply_instance
end

/-- Any functor preserves coequalizers of split pairs. -/
@[priority 1]
instance preserves_split_coequalizers (f g : X ⟶ Y) [has_split_coequalizer f g] :
  preserves_colimit (parallel_pair f g) G :=
begin
  apply preserves_colimit_of_preserves_colimit_cocone
            ((has_split_coequalizer.is_split_coequalizer f g).is_coequalizer),
  apply (is_colimit_map_cocone_cofork_equiv G _).symm
            ((has_split_coequalizer.is_split_coequalizer f g).map G).is_coequalizer,
end
end coequalizers

end category_theory.limits


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

! This file was ported from Lean 3 source module ring_theory.nilpotent
! leanprover-community/mathlib commit da420a8c6dd5bdfb85c4ced85c34388f633bc6ff
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Nat.Choose.Sum
import Mathlib.Algebra.Algebra.Bilinear
import Mathlib.RingTheory.Ideal.Operations

/-!
# Nilpotent elements

## Main definitions

  * `IsNilpotent`
  * `isNilpotent_neg_iff`
  * `Commute.isNilpotent_add`
  * `Commute.isNilpotent_mul_left`
  * `Commute.isNilpotent_mul_right`
  * `Commute.isNilpotent_sub`

-/

universe u v

variable {R S : Type u} {x y : R}

/-- An element is said to be nilpotent if some natural-number-power of it equals zero.

Note that we require only the bare minimum assumptions for the definition to make sense. Even
`MonoidWithZero` is too strong since nilpotency is important in the study of rings that are only
power-associative. -/
def IsNilpotent [Zero R] [Pow R ℕ] (x : R) : Prop :=
  ∃ n : ℕ, x ^ n = 0
#align is_nilpotent IsNilpotent

theorem IsNilpotent.mk [Zero R] [Pow R ℕ] (x : R) (n : ℕ) (e : x ^ n = 0) : IsNilpotent x :=
  ⟨n, e⟩
#align is_nilpotent.mk IsNilpotent.mk

theorem IsNilpotent.zero [MonoidWithZero R] : IsNilpotent (0 : R) :=
  ⟨1, pow_one 0⟩
#align is_nilpotent.zero IsNilpotent.zero

theorem IsNilpotent.neg [Ring R] (h : IsNilpotent x) : IsNilpotent (-x) := by
  obtain ⟨n, hn⟩ := h
  use n
  rw [neg_pow, hn, MulZeroClass.mul_zero]
#align is_nilpotent.neg IsNilpotent.neg

@[simp]
theorem isNilpotent_neg_iff [Ring R] : IsNilpotent (-x) ↔ IsNilpotent x :=
  ⟨fun h => neg_neg x ▸ h.neg, fun h => h.neg⟩
#align is_nilpotent_neg_iff isNilpotent_neg_iff

theorem IsNilpotent.map [MonoidWithZero R] [MonoidWithZero S] {r : R} {F : Type _}
    [MonoidWithZeroHomClass F R S] (hr : IsNilpotent r) (f : F) : IsNilpotent (f r) := by
  use hr.choose
  rw [← map_pow, hr.choose_spec, map_zero]
#align is_nilpotent.map IsNilpotent.map

/-- A structure that has zero and pow is reduced if it has no nonzero nilpotent elements. -/
@[mk_iff isReduced_iff]
class IsReduced (R : Type _) [Zero R] [Pow R ℕ] : Prop where
  /-- A reduced structure has no nonzero nilpotent elements. -/
  eq_zero : ∀ x : R, IsNilpotent x → x = 0
#align is_reduced IsReduced

instance (priority := 900) isReduced_of_noZeroDivisors [MonoidWithZero R] [NoZeroDivisors R] :
    IsReduced R :=
  ⟨fun _ ⟨_, hn⟩ => pow_eq_zero hn⟩
#align is_reduced_of_no_zero_divisors isReduced_of_noZeroDivisors

instance (priority := 900) isReduced_of_subsingleton [Zero R] [Pow R ℕ] [Subsingleton R] :
    IsReduced R :=
  ⟨fun _ _ => Subsingleton.elim _ _⟩
#align is_reduced_of_subsingleton isReduced_of_subsingleton

theorem IsNilpotent.eq_zero [Zero R] [Pow R ℕ] [IsReduced R] (h : IsNilpotent x) : x = 0 :=
  IsReduced.eq_zero x h
#align is_nilpotent.eq_zero IsNilpotent.eq_zero

@[simp]
theorem isNilpotent_iff_eq_zero [MonoidWithZero R] [IsReduced R] : IsNilpotent x ↔ x = 0 :=
  ⟨fun h => h.eq_zero, fun h => h.symm ▸ IsNilpotent.zero⟩
#align is_nilpotent_iff_eq_zero isNilpotent_iff_eq_zero

theorem isReduced_of_injective [MonoidWithZero R] [MonoidWithZero S] {F : Type _}
    [MonoidWithZeroHomClass F R S] (f : F) (hf : Function.Injective f) [IsReduced S] :
    IsReduced R := by
  constructor
  intro x hx
  apply hf
  rw [map_zero]
  exact (hx.map f).eq_zero
#align is_reduced_of_injective isReduced_of_injective

-- Porting note: Added etaExperiment line to synthesize RingHomClass
set_option synthInstance.etaExperiment true

theorem RingHom.ker_isRadical_iff_reduced_of_surjective {S F} [CommSemiring R] [CommRing S]
    [RingHomClass F R S] {f : F} (hf : Function.Surjective f) :
    (RingHom.ker f).IsRadical ↔ IsReduced S := by
  simp_rw [isReduced_iff, hf.forall, IsNilpotent, ← map_pow, ← RingHom.mem_ker]
  rfl
#align ring_hom.ker_is_radical_iff_reduced_of_surjective RingHom.ker_isRadical_iff_reduced_of_surjective

set_option synthInstance.etaExperiment false

/-- An element `y` in a monoid is radical if for any element `x`, `y` divides `x` whenever it
  divides a power of `x`. -/
def IsRadical [Dvd R] [Pow R ℕ] (y : R) : Prop :=
  ∀ (n : ℕ) (x), y ∣ x ^ n → y ∣ x
#align is_radical IsRadical

theorem zero_isRadical_iff [MonoidWithZero R] : IsRadical (0 : R) ↔ IsReduced R := by
  simp_rw [isReduced_iff, IsNilpotent, exists_imp, ← zero_dvd_iff]
  exact forall_swap
#align zero_is_radical_iff zero_isRadical_iff

theorem isRadical_iff_span_singleton [CommSemiring R] :
    IsRadical y ↔ (Ideal.span ({y} : Set R)).IsRadical := by
  simp_rw [IsRadical, ← Ideal.mem_span_singleton]
  exact forall_swap.trans (forall_congr' fun r => exists_imp.symm)
#align is_radical_iff_span_singleton isRadical_iff_span_singleton

theorem isRadical_iff_pow_one_lt [MonoidWithZero R] (k : ℕ) (hk : 1 < k) :
    IsRadical y ↔ ∀ x, y ∣ x ^ k → y ∣ x :=
  ⟨fun h x => h k x, fun h =>
    k.cauchy_induction_mul (fun n h x hd => h x <| (pow_succ' x n).symm ▸ hd.mul_right x) 0 hk
      (fun x hd => pow_one x ▸ hd) fun n _ hn x hd => h x <| hn _ <| (pow_mul x k n).subst hd⟩
#align is_radical_iff_pow_one_lt isRadical_iff_pow_one_lt

theorem isReduced_iff_pow_one_lt [MonoidWithZero R] (k : ℕ) (hk : 1 < k) :
    IsReduced R ↔ ∀ x : R, x ^ k = 0 → x = 0 := by
  simp_rw [← zero_isRadical_iff, isRadical_iff_pow_one_lt k hk, zero_dvd_iff]
#align is_reduced_iff_pow_one_lt isReduced_iff_pow_one_lt

namespace Commute

section Semiring

variable [Semiring R] (h_comm : Commute x y)

theorem isNilpotent_add (hx : IsNilpotent x) (hy : IsNilpotent y) : IsNilpotent (x + y) := by
  obtain ⟨n, hn⟩ := hx
  obtain ⟨m, hm⟩ := hy
  use n + m - 1
  rw [h_comm.add_pow']
  apply Finset.sum_eq_zero
  rintro ⟨i, j⟩ hij
  suffices x ^ i * y ^ j = 0 by simp only [this, nsmul_eq_mul, MulZeroClass.mul_zero]
  cases' Nat.le_or_le_of_add_eq_add_pred (Finset.Nat.mem_antidiagonal.mp hij) with hi hj
  · rw [pow_eq_zero_of_le hi hn, MulZeroClass.zero_mul]
  · rw [pow_eq_zero_of_le hj hm, MulZeroClass.mul_zero]
#align commute.is_nilpotent_add Commute.isNilpotent_add

theorem isNilpotent_mul_left (h : IsNilpotent x) : IsNilpotent (x * y) := by
  obtain ⟨n, hn⟩ := h
  use n
  rw [h_comm.mul_pow, hn, MulZeroClass.zero_mul]
#align commute.is_nilpotent_mul_left Commute.isNilpotent_mul_left

theorem isNilpotent_mul_right (h : IsNilpotent y) : IsNilpotent (x * y) := by
  rw [h_comm.eq]
  exact h_comm.symm.isNilpotent_mul_left h
#align commute.is_nilpotent_mul_right Commute.isNilpotent_mul_right

end Semiring

section Ring

variable [Ring R] (h_comm : Commute x y)

theorem isNilpotent_sub (hx : IsNilpotent x) (hy : IsNilpotent y) : IsNilpotent (x - y) := by
  rw [← neg_right_iff] at h_comm
  rw [← isNilpotent_neg_iff] at hy
  rw [sub_eq_add_neg]
  exact h_comm.isNilpotent_add hx hy
#align commute.is_nilpotent_sub Commute.isNilpotent_sub

end Ring

end Commute

section CommSemiring

variable [CommSemiring R]

/-- The nilradical of a commutative semiring is the ideal of nilpotent elements. -/
def nilradical (R : Type _) [CommSemiring R] : Ideal R :=
  (0 : Ideal R).radical
#align nilradical nilradical

theorem mem_nilradical : x ∈ nilradical R ↔ IsNilpotent x :=
  Iff.rfl
#align mem_nilradical mem_nilradical

theorem nilradical_eq_infₛ (R : Type _) [CommSemiring R] :
    nilradical R = infₛ { J : Ideal R | J.IsPrime } :=
  (Ideal.radical_eq_infₛ ⊥).trans <| by simp_rw [and_iff_right bot_le]
#align nilradical_eq_Inf nilradical_eq_infₛ

theorem nilpotent_iff_mem_prime : IsNilpotent x ↔ ∀ J : Ideal R, J.IsPrime → x ∈ J := by
  rw [← mem_nilradical, nilradical_eq_infₛ, Submodule.mem_infₛ]
  rfl
#align nilpotent_iff_mem_prime nilpotent_iff_mem_prime

theorem nilradical_le_prime (J : Ideal R) [H : J.IsPrime] : nilradical R ≤ J :=
  (nilradical_eq_infₛ R).symm ▸ infₛ_le H
#align nilradical_le_prime nilradical_le_prime

@[simp]
theorem nilradical_eq_zero (R : Type _) [CommSemiring R] [IsReduced R] : nilradical R = 0 :=
  Ideal.ext fun _ => isNilpotent_iff_eq_zero
#align nilradical_eq_zero nilradical_eq_zero

end CommSemiring

namespace LinearMap

variable (R) {A : Type v} [CommSemiring R] [Semiring A] [Algebra R A]

@[simp]
theorem isNilpotent_mulLeft_iff (a : A) : IsNilpotent (mulLeft R a) ↔ IsNilpotent a := by
  constructor <;> rintro ⟨n, hn⟩ <;> use n <;>
      simp only [mulLeft_eq_zero_iff, pow_mulLeft] at hn⊢ <;>
    exact hn
#align linear_map.is_nilpotent_mul_left_iff LinearMap.isNilpotent_mulLeft_iff

@[simp]
theorem isNilpotent_mulRight_iff (a : A) : IsNilpotent (mulRight R a) ↔ IsNilpotent a := by
  constructor <;> rintro ⟨n, hn⟩ <;> use n <;>
      simp only [mulRight_eq_zero_iff, pow_mulRight] at hn⊢ <;>
    exact hn
#align linear_map.is_nilpotent_mul_right_iff LinearMap.isNilpotent_mulRight_iff

end LinearMap

namespace Module.End

variable {M : Type v} [Ring R] [AddCommGroup M] [Module R M]

variable {f : Module.End R M} {p : Submodule R M} (hp : p ≤ p.comap f)

theorem IsNilpotent.mapQ (hnp : IsNilpotent f) : IsNilpotent (p.mapQ p f hp) := by
  obtain ⟨k, hk⟩ := hnp
  use k
  simp [← p.mapQ_pow, hk]
#align module.End.is_nilpotent.mapq Module.End.IsNilpotent.mapQ

end Module.End