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

! This file was ported from Lean 3 source module data.polynomial.mirror
! leanprover-community/mathlib commit 2196ab363eb097c008d4497125e0dde23fb36db2
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.BigOperators.NatAntidiagonal
import Mathbin.Data.Polynomial.RingDivision

/-!
# "Mirror" of a univariate polynomial

In this file we define `polynomial.mirror`, a variant of `polynomial.reverse`. The difference
between `reverse` and `mirror` is that `reverse` will decrease the degree if the polynomial is
divisible by `X`.

## Main definitions

- `polynomial.mirror`

## Main results

- `polynomial.mirror_mul_of_domain`: `mirror` preserves multiplication.
- `polynomial.irreducible_of_mirror`: an irreducibility criterion involving `mirror`

-/

namespace Polynomial

open Polynomial

section Semiring

variable {R : Type _} [Semiring R] (p q : R[X])

#print Polynomial.mirror /-
/-- mirror of a polynomial: reverses the coefficients while preserving `polynomial.nat_degree` -/
noncomputable def mirror :=
  p.reverse * X ^ p.natTrailingDegree
#align polynomial.mirror Polynomial.mirror
-/

#print Polynomial.mirror_zero /-
@[simp]
theorem mirror_zero : (0 : R[X]).mirror = 0 := by simp [mirror]
#align polynomial.mirror_zero Polynomial.mirror_zero
-/

/- warning: polynomial.mirror_monomial -> Polynomial.mirror_monomial is a dubious translation:
lean 3 declaration is
  forall {R : Type.{u1}} [_inst_1 : Semiring.{u1} R] (n : Nat) (a : R), Eq.{succ u1} (Polynomial.{u1} R _inst_1) (Polynomial.mirror.{u1} R _inst_1 (coeFn.{succ u1, succ u1} (LinearMap.{u1, u1, u1, u1} R R _inst_1 _inst_1 (RingHom.id.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1)) R (Polynomial.{u1} R _inst_1) (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1))) (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} (Polynomial.{u1} R _inst_1) (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1)))) (Semiring.toModule.{u1} R _inst_1) (Polynomial.module.{u1, u1} R _inst_1 R _inst_1 (Semiring.toModule.{u1} R _inst_1))) (fun (_x : LinearMap.{u1, u1, u1, u1} R R _inst_1 _inst_1 (RingHom.id.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1)) R (Polynomial.{u1} R _inst_1) (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1))) (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} (Polynomial.{u1} R _inst_1) (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1)))) (Semiring.toModule.{u1} R _inst_1) (Polynomial.module.{u1, u1} R _inst_1 R _inst_1 (Semiring.toModule.{u1} R _inst_1))) => R -> (Polynomial.{u1} R _inst_1)) (LinearMap.hasCoeToFun.{u1, u1, u1, u1} R R R (Polynomial.{u1} R _inst_1) _inst_1 _inst_1 (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1))) (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} (Polynomial.{u1} R _inst_1) (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1)))) (Semiring.toModule.{u1} R _inst_1) (Polynomial.module.{u1, u1} R _inst_1 R _inst_1 (Semiring.toModule.{u1} R _inst_1)) (RingHom.id.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1))) (Polynomial.monomial.{u1} R _inst_1 n) a)) (coeFn.{succ u1, succ u1} (LinearMap.{u1, u1, u1, u1} R R _inst_1 _inst_1 (RingHom.id.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1)) R (Polynomial.{u1} R _inst_1) (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1))) (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} (Polynomial.{u1} R _inst_1) (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1)))) (Semiring.toModule.{u1} R _inst_1) (Polynomial.module.{u1, u1} R _inst_1 R _inst_1 (Semiring.toModule.{u1} R _inst_1))) (fun (_x : LinearMap.{u1, u1, u1, u1} R R _inst_1 _inst_1 (RingHom.id.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1)) R (Polynomial.{u1} R _inst_1) (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1))) (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} (Polynomial.{u1} R _inst_1) (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1)))) (Semiring.toModule.{u1} R _inst_1) (Polynomial.module.{u1, u1} R _inst_1 R _inst_1 (Semiring.toModule.{u1} R _inst_1))) => R -> (Polynomial.{u1} R _inst_1)) (LinearMap.hasCoeToFun.{u1, u1, u1, u1} R R R (Polynomial.{u1} R _inst_1) _inst_1 _inst_1 (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1))) (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} (Polynomial.{u1} R _inst_1) (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1)))) (Semiring.toModule.{u1} R _inst_1) (Polynomial.module.{u1, u1} R _inst_1 R _inst_1 (Semiring.toModule.{u1} R _inst_1)) (RingHom.id.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1))) (Polynomial.monomial.{u1} R _inst_1 n) a)
but is expected to have type
  forall {R : Type.{u1}} [_inst_1 : Semiring.{u1} R] (n : Nat) (a : R), Eq.{succ u1} (Polynomial.{u1} R _inst_1) (Polynomial.mirror.{u1} R _inst_1 (FunLike.coe.{succ u1, succ u1, succ u1} (LinearMap.{u1, u1, u1, u1} R R _inst_1 _inst_1 (RingHom.id.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1)) R (Polynomial.{u1} R _inst_1) (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1))) (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} (Polynomial.{u1} R _inst_1) (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1)))) (Semiring.toModule.{u1} R _inst_1) (Polynomial.module.{u1, u1} R _inst_1 R _inst_1 (Semiring.toModule.{u1} R _inst_1))) R (fun (_x : R) => (fun (x._@.Mathlib.Algebra.Module.LinearMap._hyg.6190 : R) => Polynomial.{u1} R _inst_1) _x) (LinearMap.instFunLikeLinearMap.{u1, u1, u1, u1} R R R (Polynomial.{u1} R _inst_1) _inst_1 _inst_1 (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1))) (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} (Polynomial.{u1} R _inst_1) (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1)))) (Semiring.toModule.{u1} R _inst_1) (Polynomial.module.{u1, u1} R _inst_1 R _inst_1 (Semiring.toModule.{u1} R _inst_1)) (RingHom.id.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1))) (Polynomial.monomial.{u1} R _inst_1 n) a)) (FunLike.coe.{succ u1, succ u1, succ u1} (LinearMap.{u1, u1, u1, u1} R R _inst_1 _inst_1 (RingHom.id.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1)) R (Polynomial.{u1} R _inst_1) (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1))) (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} (Polynomial.{u1} R _inst_1) (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1)))) (Semiring.toModule.{u1} R _inst_1) (Polynomial.module.{u1, u1} R _inst_1 R _inst_1 (Semiring.toModule.{u1} R _inst_1))) R (fun (_x : R) => (fun (x._@.Mathlib.Algebra.Module.LinearMap._hyg.6190 : R) => Polynomial.{u1} R _inst_1) _x) (LinearMap.instFunLikeLinearMap.{u1, u1, u1, u1} R R R (Polynomial.{u1} R _inst_1) _inst_1 _inst_1 (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1))) (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} (Polynomial.{u1} R _inst_1) (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1)))) (Semiring.toModule.{u1} R _inst_1) (Polynomial.module.{u1, u1} R _inst_1 R _inst_1 (Semiring.toModule.{u1} R _inst_1)) (RingHom.id.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1))) (Polynomial.monomial.{u1} R _inst_1 n) a)
Case conversion may be inaccurate. Consider using '#align polynomial.mirror_monomial Polynomial.mirror_monomialₓ'. -/
theorem mirror_monomial (n : ℕ) (a : R) : (monomial n a).mirror = monomial n a := by
  classical
    by_cases ha : a = 0
    · rw [ha, monomial_zero_right, mirror_zero]
    ·
      rw [mirror, reverse, nat_degree_monomial n a, if_neg ha, nat_trailing_degree_monomial ha, ←
        C_mul_X_pow_eq_monomial, reflect_C_mul_X_pow, rev_at_le (le_refl n), tsub_self, pow_zero,
        mul_one]
#align polynomial.mirror_monomial Polynomial.mirror_monomial

/- warning: polynomial.mirror_C -> Polynomial.mirror_C is a dubious translation:
lean 3 declaration is
  forall {R : Type.{u1}} [_inst_1 : Semiring.{u1} R] (a : R), Eq.{succ u1} (Polynomial.{u1} R _inst_1) (Polynomial.mirror.{u1} R _inst_1 (coeFn.{succ u1, succ u1} (RingHom.{u1, u1} R (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1))) (fun (_x : RingHom.{u1, u1} R (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1))) => R -> (Polynomial.{u1} R _inst_1)) (RingHom.hasCoeToFun.{u1, u1} R (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1))) (Polynomial.C.{u1} R _inst_1) a)) (coeFn.{succ u1, succ u1} (RingHom.{u1, u1} R (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1))) (fun (_x : RingHom.{u1, u1} R (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1))) => R -> (Polynomial.{u1} R _inst_1)) (RingHom.hasCoeToFun.{u1, u1} R (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1))) (Polynomial.C.{u1} R _inst_1) a)
but is expected to have type
  forall {R : Type.{u1}} [_inst_1 : Semiring.{u1} R] (a : R), Eq.{succ u1} (Polynomial.{u1} R _inst_1) (Polynomial.mirror.{u1} R _inst_1 (FunLike.coe.{succ u1, succ u1, succ u1} (RingHom.{u1, u1} R (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1))) R (fun (_x : R) => (fun (x._@.Mathlib.Algebra.Hom.Group._hyg.2391 : R) => Polynomial.{u1} R _inst_1) _x) (MulHomClass.toFunLike.{u1, u1, u1} (RingHom.{u1, u1} R (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1))) R (Polynomial.{u1} R _inst_1) (NonUnitalNonAssocSemiring.toMul.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1))) (NonUnitalNonAssocSemiring.toMul.{u1} (Polynomial.{u1} R _inst_1) (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1)))) (NonUnitalRingHomClass.toMulHomClass.{u1, u1, u1} (RingHom.{u1, u1} R (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1))) R (Polynomial.{u1} R _inst_1) (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1)) (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1))) (RingHomClass.toNonUnitalRingHomClass.{u1, u1, u1} (RingHom.{u1, u1} R (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1))) R (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1)) (RingHom.instRingHomClassRingHom.{u1, u1} R (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1)))))) (Polynomial.C.{u1} R _inst_1) a)) (FunLike.coe.{succ u1, succ u1, succ u1} (RingHom.{u1, u1} R (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1))) R (fun (_x : R) => (fun (x._@.Mathlib.Algebra.Hom.Group._hyg.2391 : R) => Polynomial.{u1} R _inst_1) _x) (MulHomClass.toFunLike.{u1, u1, u1} (RingHom.{u1, u1} R (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1))) R (Polynomial.{u1} R _inst_1) (NonUnitalNonAssocSemiring.toMul.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1))) (NonUnitalNonAssocSemiring.toMul.{u1} (Polynomial.{u1} R _inst_1) (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1)))) (NonUnitalRingHomClass.toMulHomClass.{u1, u1, u1} (RingHom.{u1, u1} R (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1))) R (Polynomial.{u1} R _inst_1) (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1)) (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1))) (RingHomClass.toNonUnitalRingHomClass.{u1, u1, u1} (RingHom.{u1, u1} R (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1))) R (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1)) (RingHom.instRingHomClassRingHom.{u1, u1} R (Polynomial.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} R _inst_1) (Semiring.toNonAssocSemiring.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.semiring.{u1} R _inst_1)))))) (Polynomial.C.{u1} R _inst_1) a)
Case conversion may be inaccurate. Consider using '#align polynomial.mirror_C Polynomial.mirror_Cₓ'. -/
theorem mirror_C (a : R) : (C a).mirror = C a :=
  mirror_monomial 0 a
#align polynomial.mirror_C Polynomial.mirror_C

#print Polynomial.mirror_X /-
theorem mirror_X : X.mirror = (X : R[X]) :=
  mirror_monomial 1 (1 : R)
#align polynomial.mirror_X Polynomial.mirror_X
-/

#print Polynomial.mirror_natDegree /-
theorem mirror_natDegree : p.mirror.natDegree = p.natDegree :=
  by
  by_cases hp : p = 0
  · rw [hp, mirror_zero]
  nontriviality R
  rw [mirror, nat_degree_mul', reverse_nat_degree, nat_degree_X_pow,
    tsub_add_cancel_of_le p.nat_trailing_degree_le_nat_degree]
  rwa [leading_coeff_X_pow, mul_one, reverse_leading_coeff, Ne, trailing_coeff_eq_zero]
#align polynomial.mirror_nat_degree Polynomial.mirror_natDegree
-/

#print Polynomial.mirror_natTrailingDegree /-
theorem mirror_natTrailingDegree : p.mirror.natTrailingDegree = p.natTrailingDegree :=
  by
  by_cases hp : p = 0
  · rw [hp, mirror_zero]
  ·
    rw [mirror, nat_trailing_degree_mul_X_pow ((mt reverse_eq_zero.mp) hp),
      reverse_nat_trailing_degree, zero_add]
#align polynomial.mirror_nat_trailing_degree Polynomial.mirror_natTrailingDegree
-/

#print Polynomial.coeff_mirror /-
theorem coeff_mirror (n : ℕ) :
    p.mirror.coeff n = p.coeff (revAt (p.natDegree + p.natTrailingDegree) n) :=
  by
  by_cases h2 : p.nat_degree < n
  · rw [coeff_eq_zero_of_nat_degree_lt (by rwa [mirror_nat_degree])]
    by_cases h1 : n ≤ p.nat_degree + p.nat_trailing_degree
    · rw [rev_at_le h1, coeff_eq_zero_of_lt_nat_trailing_degree]
      exact (tsub_lt_iff_left h1).mpr (Nat.add_lt_add_right h2 _)
    · rw [← rev_at_fun_eq, rev_at_fun, if_neg h1, coeff_eq_zero_of_nat_degree_lt h2]
  rw [not_lt] at h2
  rw [rev_at_le (h2.trans (Nat.le_add_right _ _))]
  by_cases h3 : p.nat_trailing_degree ≤ n
  ·
    rw [← tsub_add_eq_add_tsub h2, ← tsub_tsub_assoc h2 h3, mirror, coeff_mul_X_pow', if_pos h3,
      coeff_reverse, rev_at_le (tsub_le_self.trans h2)]
  rw [not_le] at h3
  rw [coeff_eq_zero_of_nat_degree_lt (lt_tsub_iff_right.mpr (Nat.add_lt_add_left h3 _))]
  exact coeff_eq_zero_of_lt_nat_trailing_degree (by rwa [mirror_nat_trailing_degree])
#align polynomial.coeff_mirror Polynomial.coeff_mirror
-/

#print Polynomial.mirror_eval_one /-
--TODO: Extract `finset.sum_range_rev_at` lemma.
theorem mirror_eval_one : p.mirror.eval 1 = p.eval 1 :=
  by
  simp_rw [eval_eq_sum_range, one_pow, mul_one, mirror_nat_degree]
  refine' Finset.sum_bij_ne_zero _ _ _ _ _
  · exact fun n hn hp => rev_at (p.nat_degree + p.nat_trailing_degree) n
  · intro n hn hp
    rw [Finset.mem_range_succ_iff] at *
    rw [rev_at_le (hn.trans (Nat.le_add_right _ _))]
    rw [tsub_le_iff_tsub_le, add_comm, add_tsub_cancel_right, ← mirror_nat_trailing_degree]
    exact nat_trailing_degree_le_of_ne_zero hp
  · exact fun n₁ n₂ hn₁ hp₁ hn₂ hp₂ h => by rw [← @rev_at_invol _ n₁, h, rev_at_invol]
  · intro n hn hp
    use rev_at (p.nat_degree + p.nat_trailing_degree) n
    refine' ⟨_, _, rev_at_invol.symm⟩
    · rw [Finset.mem_range_succ_iff] at *
      rw [rev_at_le (hn.trans (Nat.le_add_right _ _))]
      rw [tsub_le_iff_tsub_le, add_comm, add_tsub_cancel_right]
      exact nat_trailing_degree_le_of_ne_zero hp
    · change p.mirror.coeff _ ≠ 0
      rwa [coeff_mirror, rev_at_invol]
  · exact fun n hn hp => p.coeff_mirror n
#align polynomial.mirror_eval_one Polynomial.mirror_eval_one
-/

#print Polynomial.mirror_mirror /-
theorem mirror_mirror : p.mirror.mirror = p :=
  Polynomial.ext fun n => by
    rw [coeff_mirror, coeff_mirror, mirror_nat_degree, mirror_nat_trailing_degree, rev_at_invol]
#align polynomial.mirror_mirror Polynomial.mirror_mirror
-/

variable {p q}

#print Polynomial.mirror_involutive /-
theorem mirror_involutive : Function.Involutive (mirror : R[X] → R[X]) :=
  mirror_mirror
#align polynomial.mirror_involutive Polynomial.mirror_involutive
-/

#print Polynomial.mirror_eq_iff /-
theorem mirror_eq_iff : p.mirror = q ↔ p = q.mirror :=
  mirror_involutive.eq_iff
#align polynomial.mirror_eq_iff Polynomial.mirror_eq_iff
-/

#print Polynomial.mirror_inj /-
@[simp]
theorem mirror_inj : p.mirror = q.mirror ↔ p = q :=
  mirror_involutive.Injective.eq_iff
#align polynomial.mirror_inj Polynomial.mirror_inj
-/

#print Polynomial.mirror_eq_zero /-
@[simp]
theorem mirror_eq_zero : p.mirror = 0 ↔ p = 0 :=
  ⟨fun h => by rw [← p.mirror_mirror, h, mirror_zero], fun h => by rw [h, mirror_zero]⟩
#align polynomial.mirror_eq_zero Polynomial.mirror_eq_zero
-/

variable (p q)

#print Polynomial.mirror_trailingCoeff /-
@[simp]
theorem mirror_trailingCoeff : p.mirror.trailingCoeff = p.leadingCoeff := by
  rw [leading_coeff, trailing_coeff, mirror_nat_trailing_degree, coeff_mirror,
    rev_at_le (Nat.le_add_left _ _), add_tsub_cancel_right]
#align polynomial.mirror_trailing_coeff Polynomial.mirror_trailingCoeff
-/

#print Polynomial.mirror_leadingCoeff /-
@[simp]
theorem mirror_leadingCoeff : p.mirror.leadingCoeff = p.trailingCoeff := by
  rw [← p.mirror_mirror, mirror_trailing_coeff, p.mirror_mirror]
#align polynomial.mirror_leading_coeff Polynomial.mirror_leadingCoeff
-/

#print Polynomial.coeff_mul_mirror /-
theorem coeff_mul_mirror :
    (p * p.mirror).coeff (p.natDegree + p.natTrailingDegree) = p.Sum fun n => (· ^ 2) :=
  by
  rw [coeff_mul, Finset.Nat.sum_antidiagonal_eq_sum_range_succ_mk]
  refine'
    (Finset.sum_congr rfl fun n hn => _).trans
      (p.sum_eq_of_subset (fun n => (· ^ 2)) (fun n => zero_pow zero_lt_two) _ fun n hn =>
          finset.mem_range_succ_iff.mpr
            ((le_nat_degree_of_mem_supp n hn).trans (Nat.le_add_right _ _))).symm
  rw [coeff_mirror, ← rev_at_le (finset.mem_range_succ_iff.mp hn), rev_at_invol, ← sq]
#align polynomial.coeff_mul_mirror Polynomial.coeff_mul_mirror
-/

variable [NoZeroDivisors R]

/- warning: polynomial.nat_degree_mul_mirror -> Polynomial.natDegree_mul_mirror is a dubious translation:
lean 3 declaration is
  forall {R : Type.{u1}} [_inst_1 : Semiring.{u1} R] (p : Polynomial.{u1} R _inst_1) [_inst_2 : NoZeroDivisors.{u1} R (Distrib.toHasMul.{u1} R (NonUnitalNonAssocSemiring.toDistrib.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1)))) (MulZeroClass.toHasZero.{u1} R (NonUnitalNonAssocSemiring.toMulZeroClass.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1))))], Eq.{1} Nat (Polynomial.natDegree.{u1} R _inst_1 (HMul.hMul.{u1, u1, u1} (Polynomial.{u1} R _inst_1) (Polynomial.{u1} R _inst_1) (Polynomial.{u1} R _inst_1) (instHMul.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.mul'.{u1} R _inst_1)) p (Polynomial.mirror.{u1} R _inst_1 p))) (HMul.hMul.{0, 0, 0} Nat Nat Nat (instHMul.{0} Nat Nat.hasMul) (OfNat.ofNat.{0} Nat 2 (OfNat.mk.{0} Nat 2 (bit0.{0} Nat Nat.hasAdd (One.one.{0} Nat Nat.hasOne)))) (Polynomial.natDegree.{u1} R _inst_1 p))
but is expected to have type
  forall {R : Type.{u1}} [_inst_1 : Semiring.{u1} R] (p : Polynomial.{u1} R _inst_1) [_inst_2 : NoZeroDivisors.{u1} R (NonUnitalNonAssocSemiring.toMul.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1))) (MonoidWithZero.toZero.{u1} R (Semiring.toMonoidWithZero.{u1} R _inst_1))], Eq.{1} Nat (Polynomial.natDegree.{u1} R _inst_1 (HMul.hMul.{u1, u1, u1} (Polynomial.{u1} R _inst_1) (Polynomial.{u1} R _inst_1) (Polynomial.{u1} R _inst_1) (instHMul.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.mul'.{u1} R _inst_1)) p (Polynomial.mirror.{u1} R _inst_1 p))) (HMul.hMul.{0, 0, 0} Nat Nat Nat (instHMul.{0} Nat instMulNat) (OfNat.ofNat.{0} Nat 2 (instOfNatNat 2)) (Polynomial.natDegree.{u1} R _inst_1 p))
Case conversion may be inaccurate. Consider using '#align polynomial.nat_degree_mul_mirror Polynomial.natDegree_mul_mirrorₓ'. -/
theorem natDegree_mul_mirror : (p * p.mirror).natDegree = 2 * p.natDegree :=
  by
  by_cases hp : p = 0
  · rw [hp, MulZeroClass.zero_mul, nat_degree_zero, MulZeroClass.mul_zero]
  rw [nat_degree_mul hp (mt mirror_eq_zero.mp hp), mirror_nat_degree, two_mul]
#align polynomial.nat_degree_mul_mirror Polynomial.natDegree_mul_mirror

/- warning: polynomial.nat_trailing_degree_mul_mirror -> Polynomial.natTrailingDegree_mul_mirror is a dubious translation:
lean 3 declaration is
  forall {R : Type.{u1}} [_inst_1 : Semiring.{u1} R] (p : Polynomial.{u1} R _inst_1) [_inst_2 : NoZeroDivisors.{u1} R (Distrib.toHasMul.{u1} R (NonUnitalNonAssocSemiring.toDistrib.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1)))) (MulZeroClass.toHasZero.{u1} R (NonUnitalNonAssocSemiring.toMulZeroClass.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1))))], Eq.{1} Nat (Polynomial.natTrailingDegree.{u1} R _inst_1 (HMul.hMul.{u1, u1, u1} (Polynomial.{u1} R _inst_1) (Polynomial.{u1} R _inst_1) (Polynomial.{u1} R _inst_1) (instHMul.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.mul'.{u1} R _inst_1)) p (Polynomial.mirror.{u1} R _inst_1 p))) (HMul.hMul.{0, 0, 0} Nat Nat Nat (instHMul.{0} Nat Nat.hasMul) (OfNat.ofNat.{0} Nat 2 (OfNat.mk.{0} Nat 2 (bit0.{0} Nat Nat.hasAdd (One.one.{0} Nat Nat.hasOne)))) (Polynomial.natTrailingDegree.{u1} R _inst_1 p))
but is expected to have type
  forall {R : Type.{u1}} [_inst_1 : Semiring.{u1} R] (p : Polynomial.{u1} R _inst_1) [_inst_2 : NoZeroDivisors.{u1} R (NonUnitalNonAssocSemiring.toMul.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R _inst_1))) (MonoidWithZero.toZero.{u1} R (Semiring.toMonoidWithZero.{u1} R _inst_1))], Eq.{1} Nat (Polynomial.natTrailingDegree.{u1} R _inst_1 (HMul.hMul.{u1, u1, u1} (Polynomial.{u1} R _inst_1) (Polynomial.{u1} R _inst_1) (Polynomial.{u1} R _inst_1) (instHMul.{u1} (Polynomial.{u1} R _inst_1) (Polynomial.mul'.{u1} R _inst_1)) p (Polynomial.mirror.{u1} R _inst_1 p))) (HMul.hMul.{0, 0, 0} Nat Nat Nat (instHMul.{0} Nat instMulNat) (OfNat.ofNat.{0} Nat 2 (instOfNatNat 2)) (Polynomial.natTrailingDegree.{u1} R _inst_1 p))
Case conversion may be inaccurate. Consider using '#align polynomial.nat_trailing_degree_mul_mirror Polynomial.natTrailingDegree_mul_mirrorₓ'. -/
theorem natTrailingDegree_mul_mirror : (p * p.mirror).natTrailingDegree = 2 * p.natTrailingDegree :=
  by
  by_cases hp : p = 0
  · rw [hp, MulZeroClass.zero_mul, nat_trailing_degree_zero, MulZeroClass.mul_zero]
  rw [nat_trailing_degree_mul hp (mt mirror_eq_zero.mp hp), mirror_nat_trailing_degree, two_mul]
#align polynomial.nat_trailing_degree_mul_mirror Polynomial.natTrailingDegree_mul_mirror

end Semiring

section Ring

variable {R : Type _} [Ring R] (p q : R[X])

#print Polynomial.mirror_neg /-
theorem mirror_neg : (-p).mirror = -p.mirror := by
  rw [mirror, mirror, reverse_neg, nat_trailing_degree_neg, neg_mul_eq_neg_mul]
#align polynomial.mirror_neg Polynomial.mirror_neg
-/

variable [NoZeroDivisors R]

/- warning: polynomial.mirror_mul_of_domain -> Polynomial.mirror_mul_of_domain is a dubious translation:
lean 3 declaration is
  forall {R : Type.{u1}} [_inst_1 : Ring.{u1} R] (p : Polynomial.{u1} R (Ring.toSemiring.{u1} R _inst_1)) (q : Polynomial.{u1} R (Ring.toSemiring.{u1} R _inst_1)) [_inst_2 : NoZeroDivisors.{u1} R (Distrib.toHasMul.{u1} R (Ring.toDistrib.{u1} R _inst_1)) (MulZeroClass.toHasZero.{u1} R (NonUnitalNonAssocSemiring.toMulZeroClass.{u1} R (NonUnitalNonAssocRing.toNonUnitalNonAssocSemiring.{u1} R (NonAssocRing.toNonUnitalNonAssocRing.{u1} R (Ring.toNonAssocRing.{u1} R _inst_1)))))], Eq.{succ u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R _inst_1)) (Polynomial.mirror.{u1} R (Ring.toSemiring.{u1} R _inst_1) (HMul.hMul.{u1, u1, u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R _inst_1)) (Polynomial.{u1} R (Ring.toSemiring.{u1} R _inst_1)) (Polynomial.{u1} R (Ring.toSemiring.{u1} R _inst_1)) (instHMul.{u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R _inst_1)) (Polynomial.mul'.{u1} R (Ring.toSemiring.{u1} R _inst_1))) p q)) (HMul.hMul.{u1, u1, u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R _inst_1)) (Polynomial.{u1} R (Ring.toSemiring.{u1} R _inst_1)) (Polynomial.{u1} R (Ring.toSemiring.{u1} R _inst_1)) (instHMul.{u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R _inst_1)) (Polynomial.mul'.{u1} R (Ring.toSemiring.{u1} R _inst_1))) (Polynomial.mirror.{u1} R (Ring.toSemiring.{u1} R _inst_1) p) (Polynomial.mirror.{u1} R (Ring.toSemiring.{u1} R _inst_1) q))
but is expected to have type
  forall {R : Type.{u1}} [_inst_1 : Ring.{u1} R] (p : Polynomial.{u1} R (Ring.toSemiring.{u1} R _inst_1)) (q : Polynomial.{u1} R (Ring.toSemiring.{u1} R _inst_1)) [_inst_2 : NoZeroDivisors.{u1} R (NonUnitalNonAssocRing.toMul.{u1} R (NonAssocRing.toNonUnitalNonAssocRing.{u1} R (Ring.toNonAssocRing.{u1} R _inst_1))) (MonoidWithZero.toZero.{u1} R (Semiring.toMonoidWithZero.{u1} R (Ring.toSemiring.{u1} R _inst_1)))], Eq.{succ u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R _inst_1)) (Polynomial.mirror.{u1} R (Ring.toSemiring.{u1} R _inst_1) (HMul.hMul.{u1, u1, u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R _inst_1)) (Polynomial.{u1} R (Ring.toSemiring.{u1} R _inst_1)) (Polynomial.{u1} R (Ring.toSemiring.{u1} R _inst_1)) (instHMul.{u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R _inst_1)) (Polynomial.mul'.{u1} R (Ring.toSemiring.{u1} R _inst_1))) p q)) (HMul.hMul.{u1, u1, u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R _inst_1)) (Polynomial.{u1} R (Ring.toSemiring.{u1} R _inst_1)) (Polynomial.{u1} R (Ring.toSemiring.{u1} R _inst_1)) (instHMul.{u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R _inst_1)) (Polynomial.mul'.{u1} R (Ring.toSemiring.{u1} R _inst_1))) (Polynomial.mirror.{u1} R (Ring.toSemiring.{u1} R _inst_1) p) (Polynomial.mirror.{u1} R (Ring.toSemiring.{u1} R _inst_1) q))
Case conversion may be inaccurate. Consider using '#align polynomial.mirror_mul_of_domain Polynomial.mirror_mul_of_domainₓ'. -/
theorem mirror_mul_of_domain : (p * q).mirror = p.mirror * q.mirror :=
  by
  by_cases hp : p = 0
  · rw [hp, MulZeroClass.zero_mul, mirror_zero, MulZeroClass.zero_mul]
  by_cases hq : q = 0
  · rw [hq, MulZeroClass.mul_zero, mirror_zero, MulZeroClass.mul_zero]
  rw [mirror, mirror, mirror, reverse_mul_of_domain, nat_trailing_degree_mul hp hq, pow_add]
  rw [mul_assoc, ← mul_assoc q.reverse]
  conv_lhs =>
    congr
    skip
    congr
    rw [← X_pow_mul]
  repeat' rw [mul_assoc]
#align polynomial.mirror_mul_of_domain Polynomial.mirror_mul_of_domain

/- warning: polynomial.mirror_smul -> Polynomial.mirror_smul is a dubious translation:
lean 3 declaration is
  forall {R : Type.{u1}} [_inst_1 : Ring.{u1} R] (p : Polynomial.{u1} R (Ring.toSemiring.{u1} R _inst_1)) [_inst_2 : NoZeroDivisors.{u1} R (Distrib.toHasMul.{u1} R (Ring.toDistrib.{u1} R _inst_1)) (MulZeroClass.toHasZero.{u1} R (NonUnitalNonAssocSemiring.toMulZeroClass.{u1} R (NonUnitalNonAssocRing.toNonUnitalNonAssocSemiring.{u1} R (NonAssocRing.toNonUnitalNonAssocRing.{u1} R (Ring.toNonAssocRing.{u1} R _inst_1)))))] (a : R), Eq.{succ u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R _inst_1)) (Polynomial.mirror.{u1} R (Ring.toSemiring.{u1} R _inst_1) (SMul.smul.{u1, u1} R (Polynomial.{u1} R (Ring.toSemiring.{u1} R _inst_1)) (SMulZeroClass.toHasSmul.{u1, u1} R (Polynomial.{u1} R (Ring.toSemiring.{u1} R _inst_1)) (Polynomial.zero.{u1} R (Ring.toSemiring.{u1} R _inst_1)) (Polynomial.smulZeroClass.{u1, u1} R (Ring.toSemiring.{u1} R _inst_1) R (SMulWithZero.toSmulZeroClass.{u1, u1} R R (MulZeroClass.toHasZero.{u1} R (NonUnitalNonAssocSemiring.toMulZeroClass.{u1} R (NonUnitalNonAssocRing.toNonUnitalNonAssocSemiring.{u1} R (NonAssocRing.toNonUnitalNonAssocRing.{u1} R (Ring.toNonAssocRing.{u1} R _inst_1))))) (MulZeroClass.toHasZero.{u1} R (NonUnitalNonAssocSemiring.toMulZeroClass.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R (Ring.toSemiring.{u1} R _inst_1))))) (MulZeroClass.toSMulWithZero.{u1} R (NonUnitalNonAssocSemiring.toMulZeroClass.{u1} R (NonUnitalNonAssocRing.toNonUnitalNonAssocSemiring.{u1} R (NonAssocRing.toNonUnitalNonAssocRing.{u1} R (Ring.toNonAssocRing.{u1} R _inst_1)))))))) a p)) (SMul.smul.{u1, u1} R (Polynomial.{u1} R (Ring.toSemiring.{u1} R _inst_1)) (SMulZeroClass.toHasSmul.{u1, u1} R (Polynomial.{u1} R (Ring.toSemiring.{u1} R _inst_1)) (Polynomial.zero.{u1} R (Ring.toSemiring.{u1} R _inst_1)) (Polynomial.smulZeroClass.{u1, u1} R (Ring.toSemiring.{u1} R _inst_1) R (SMulWithZero.toSmulZeroClass.{u1, u1} R R (MulZeroClass.toHasZero.{u1} R (NonUnitalNonAssocSemiring.toMulZeroClass.{u1} R (NonUnitalNonAssocRing.toNonUnitalNonAssocSemiring.{u1} R (NonAssocRing.toNonUnitalNonAssocRing.{u1} R (Ring.toNonAssocRing.{u1} R _inst_1))))) (MulZeroClass.toHasZero.{u1} R (NonUnitalNonAssocSemiring.toMulZeroClass.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R (Ring.toSemiring.{u1} R _inst_1))))) (MulZeroClass.toSMulWithZero.{u1} R (NonUnitalNonAssocSemiring.toMulZeroClass.{u1} R (NonUnitalNonAssocRing.toNonUnitalNonAssocSemiring.{u1} R (NonAssocRing.toNonUnitalNonAssocRing.{u1} R (Ring.toNonAssocRing.{u1} R _inst_1)))))))) a (Polynomial.mirror.{u1} R (Ring.toSemiring.{u1} R _inst_1) p))
but is expected to have type
  forall {R : Type.{u1}} [_inst_1 : Ring.{u1} R] (p : Polynomial.{u1} R (Ring.toSemiring.{u1} R _inst_1)) [_inst_2 : NoZeroDivisors.{u1} R (NonUnitalNonAssocRing.toMul.{u1} R (NonAssocRing.toNonUnitalNonAssocRing.{u1} R (Ring.toNonAssocRing.{u1} R _inst_1))) (MonoidWithZero.toZero.{u1} R (Semiring.toMonoidWithZero.{u1} R (Ring.toSemiring.{u1} R _inst_1)))] (a : R), Eq.{succ u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R _inst_1)) (Polynomial.mirror.{u1} R (Ring.toSemiring.{u1} R _inst_1) (HSMul.hSMul.{u1, u1, u1} R (Polynomial.{u1} R (Ring.toSemiring.{u1} R _inst_1)) (Polynomial.{u1} R (Ring.toSemiring.{u1} R _inst_1)) (instHSMul.{u1, u1} R (Polynomial.{u1} R (Ring.toSemiring.{u1} R _inst_1)) (SMulZeroClass.toSMul.{u1, u1} R (Polynomial.{u1} R (Ring.toSemiring.{u1} R _inst_1)) (Polynomial.zero.{u1} R (Ring.toSemiring.{u1} R _inst_1)) (Polynomial.smulZeroClass.{u1, u1} R (Ring.toSemiring.{u1} R _inst_1) R (SMulWithZero.toSMulZeroClass.{u1, u1} R R (MonoidWithZero.toZero.{u1} R (Semiring.toMonoidWithZero.{u1} R (Ring.toSemiring.{u1} R _inst_1))) (MonoidWithZero.toZero.{u1} R (Semiring.toMonoidWithZero.{u1} R (Ring.toSemiring.{u1} R _inst_1))) (MulZeroClass.toSMulWithZero.{u1} R (NonUnitalNonAssocSemiring.toMulZeroClass.{u1} R (NonUnitalNonAssocRing.toNonUnitalNonAssocSemiring.{u1} R (NonAssocRing.toNonUnitalNonAssocRing.{u1} R (Ring.toNonAssocRing.{u1} R _inst_1))))))))) a p)) (HSMul.hSMul.{u1, u1, u1} R (Polynomial.{u1} R (Ring.toSemiring.{u1} R _inst_1)) (Polynomial.{u1} R (Ring.toSemiring.{u1} R _inst_1)) (instHSMul.{u1, u1} R (Polynomial.{u1} R (Ring.toSemiring.{u1} R _inst_1)) (SMulZeroClass.toSMul.{u1, u1} R (Polynomial.{u1} R (Ring.toSemiring.{u1} R _inst_1)) (Polynomial.zero.{u1} R (Ring.toSemiring.{u1} R _inst_1)) (Polynomial.smulZeroClass.{u1, u1} R (Ring.toSemiring.{u1} R _inst_1) R (SMulWithZero.toSMulZeroClass.{u1, u1} R R (MonoidWithZero.toZero.{u1} R (Semiring.toMonoidWithZero.{u1} R (Ring.toSemiring.{u1} R _inst_1))) (MonoidWithZero.toZero.{u1} R (Semiring.toMonoidWithZero.{u1} R (Ring.toSemiring.{u1} R _inst_1))) (MulZeroClass.toSMulWithZero.{u1} R (NonUnitalNonAssocSemiring.toMulZeroClass.{u1} R (NonUnitalNonAssocRing.toNonUnitalNonAssocSemiring.{u1} R (NonAssocRing.toNonUnitalNonAssocRing.{u1} R (Ring.toNonAssocRing.{u1} R _inst_1))))))))) a (Polynomial.mirror.{u1} R (Ring.toSemiring.{u1} R _inst_1) p))
Case conversion may be inaccurate. Consider using '#align polynomial.mirror_smul Polynomial.mirror_smulₓ'. -/
theorem mirror_smul (a : R) : (a • p).mirror = a • p.mirror := by
  rw [← C_mul', ← C_mul', mirror_mul_of_domain, mirror_C]
#align polynomial.mirror_smul Polynomial.mirror_smul

end Ring

section CommRing

variable {R : Type _} [CommRing R] [NoZeroDivisors R] {f : R[X]}

/- warning: polynomial.irreducible_of_mirror -> Polynomial.irreducible_of_mirror is a dubious translation:
lean 3 declaration is
  forall {R : Type.{u1}} [_inst_1 : CommRing.{u1} R] [_inst_2 : NoZeroDivisors.{u1} R (Distrib.toHasMul.{u1} R (Ring.toDistrib.{u1} R (CommRing.toRing.{u1} R _inst_1))) (MulZeroClass.toHasZero.{u1} R (NonUnitalNonAssocSemiring.toMulZeroClass.{u1} R (NonUnitalNonAssocRing.toNonUnitalNonAssocSemiring.{u1} R (NonAssocRing.toNonUnitalNonAssocRing.{u1} R (Ring.toNonAssocRing.{u1} R (CommRing.toRing.{u1} R _inst_1))))))] {f : Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))}, (Not (IsUnit.{u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Ring.toMonoid.{u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Polynomial.ring.{u1} R (CommRing.toRing.{u1} R _inst_1))) f)) -> (forall (k : Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))), (Eq.{succ u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (HMul.hMul.{u1, u1, u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (instHMul.{u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Polynomial.mul'.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)))) f (Polynomial.mirror.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)) f)) (HMul.hMul.{u1, u1, u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (instHMul.{u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Polynomial.mul'.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)))) k (Polynomial.mirror.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)) k))) -> (Or (Eq.{succ u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) k f) (Or (Eq.{succ u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) k (Neg.neg.{u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Polynomial.neg'.{u1} R (CommRing.toRing.{u1} R _inst_1)) f)) (Or (Eq.{succ u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) k (Polynomial.mirror.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)) f)) (Eq.{succ u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) k (Neg.neg.{u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Polynomial.neg'.{u1} R (CommRing.toRing.{u1} R _inst_1)) (Polynomial.mirror.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)) f))))))) -> (forall (g : Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))), (Dvd.Dvd.{u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (semigroupDvd.{u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (SemigroupWithZero.toSemigroup.{u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (NonUnitalSemiring.toSemigroupWithZero.{u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (NonUnitalRing.toNonUnitalSemiring.{u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (NonUnitalCommRing.toNonUnitalRing.{u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (CommRing.toNonUnitalCommRing.{u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Polynomial.commRing.{u1} R _inst_1))))))) g f) -> (Dvd.Dvd.{u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (semigroupDvd.{u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (SemigroupWithZero.toSemigroup.{u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (NonUnitalSemiring.toSemigroupWithZero.{u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (NonUnitalRing.toNonUnitalSemiring.{u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (NonUnitalCommRing.toNonUnitalRing.{u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (CommRing.toNonUnitalCommRing.{u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Polynomial.commRing.{u1} R _inst_1))))))) g (Polynomial.mirror.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)) f)) -> (IsUnit.{u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Ring.toMonoid.{u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Polynomial.ring.{u1} R (CommRing.toRing.{u1} R _inst_1))) g)) -> (Irreducible.{u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Ring.toMonoid.{u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Polynomial.ring.{u1} R (CommRing.toRing.{u1} R _inst_1))) f)
but is expected to have type
  forall {R : Type.{u1}} [_inst_1 : CommRing.{u1} R] [_inst_2 : NoZeroDivisors.{u1} R (NonUnitalNonAssocRing.toMul.{u1} R (NonAssocRing.toNonUnitalNonAssocRing.{u1} R (Ring.toNonAssocRing.{u1} R (CommRing.toRing.{u1} R _inst_1)))) (CommMonoidWithZero.toZero.{u1} R (CommSemiring.toCommMonoidWithZero.{u1} R (CommRing.toCommSemiring.{u1} R _inst_1)))] {f : Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))}, (Not (IsUnit.{u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (MonoidWithZero.toMonoid.{u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Semiring.toMonoidWithZero.{u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Polynomial.semiring.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))))) f)) -> (forall (k : Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))), (Eq.{succ u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (HMul.hMul.{u1, u1, u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (instHMul.{u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Polynomial.mul'.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)))) f (Polynomial.mirror.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)) f)) (HMul.hMul.{u1, u1, u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (instHMul.{u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Polynomial.mul'.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)))) k (Polynomial.mirror.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)) k))) -> (Or (Eq.{succ u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) k f) (Or (Eq.{succ u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) k (Neg.neg.{u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Polynomial.neg'.{u1} R (CommRing.toRing.{u1} R _inst_1)) f)) (Or (Eq.{succ u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) k (Polynomial.mirror.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)) f)) (Eq.{succ u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) k (Neg.neg.{u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Polynomial.neg'.{u1} R (CommRing.toRing.{u1} R _inst_1)) (Polynomial.mirror.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)) f))))))) -> (forall (g : Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))), (Dvd.dvd.{u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (semigroupDvd.{u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (SemigroupWithZero.toSemigroup.{u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (NonUnitalSemiring.toSemigroupWithZero.{u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (NonUnitalRing.toNonUnitalSemiring.{u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (NonUnitalCommRing.toNonUnitalRing.{u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (CommRing.toNonUnitalCommRing.{u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Polynomial.commRing.{u1} R _inst_1))))))) g f) -> (Dvd.dvd.{u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (semigroupDvd.{u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (SemigroupWithZero.toSemigroup.{u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (NonUnitalSemiring.toSemigroupWithZero.{u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (NonUnitalRing.toNonUnitalSemiring.{u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (NonUnitalCommRing.toNonUnitalRing.{u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (CommRing.toNonUnitalCommRing.{u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Polynomial.commRing.{u1} R _inst_1))))))) g (Polynomial.mirror.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1)) f)) -> (IsUnit.{u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (MonoidWithZero.toMonoid.{u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Semiring.toMonoidWithZero.{u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Polynomial.semiring.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))))) g)) -> (Irreducible.{u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (MonoidWithZero.toMonoid.{u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Semiring.toMonoidWithZero.{u1} (Polynomial.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))) (Polynomial.semiring.{u1} R (Ring.toSemiring.{u1} R (CommRing.toRing.{u1} R _inst_1))))) f)
Case conversion may be inaccurate. Consider using '#align polynomial.irreducible_of_mirror Polynomial.irreducible_of_mirrorₓ'. -/
theorem irreducible_of_mirror (h1 : ¬IsUnit f)
    (h2 : ∀ k, f * f.mirror = k * k.mirror → k = f ∨ k = -f ∨ k = f.mirror ∨ k = -f.mirror)
    (h3 : ∀ g, g ∣ f → g ∣ f.mirror → IsUnit g) : Irreducible f :=
  by
  constructor
  · exact h1
  · intro g h fgh
    let k := g * h.mirror
    have key : f * f.mirror = k * k.mirror := by
      rw [fgh, mirror_mul_of_domain, mirror_mul_of_domain, mirror_mirror, mul_assoc, mul_comm h,
        mul_comm g.mirror, mul_assoc, ← mul_assoc]
    have g_dvd_f : g ∣ f := by
      rw [fgh]
      exact dvd_mul_right g h
    have h_dvd_f : h ∣ f := by
      rw [fgh]
      exact dvd_mul_left h g
    have g_dvd_k : g ∣ k := dvd_mul_right g h.mirror
    have h_dvd_k_rev : h ∣ k.mirror :=
      by
      rw [mirror_mul_of_domain, mirror_mirror]
      exact dvd_mul_left h g.mirror
    have hk := h2 k key
    rcases hk with (hk | hk | hk | hk)
    · exact Or.inr (h3 h h_dvd_f (by rwa [← hk]))
    · exact Or.inr (h3 h h_dvd_f (by rwa [← neg_eq_iff_eq_neg.mpr hk, mirror_neg, dvd_neg]))
    · exact Or.inl (h3 g g_dvd_f (by rwa [← hk]))
    · exact Or.inl (h3 g g_dvd_f (by rwa [← neg_eq_iff_eq_neg.mpr hk, dvd_neg]))
#align polynomial.irreducible_of_mirror Polynomial.irreducible_of_mirror

end CommRing

end Polynomial


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

import ring_theory.adjoin.basic
import algebra.lie.of_associative

/-!
# Derivations

This file defines derivation. A derivation `D` from the `R`-algebra `A` to the `A`-module `M` is an
`R`-linear map that satisfy the Leibniz rule `D (a * b) = a * D b + D a * b`.

## Notation

The notation `⁅D1, D2⁆` is used for the commutator of two derivations.

TODO: this file is just a stub to go on with some PRs in the geometry section. It only
implements the definition of derivations in commutative algebra. This will soon change: as soon
as bimodules will be there in mathlib I will change this file to take into account the
non-commutative case. Any development on the theory of derivations is discouraged until the
definitive definition of derivation will be implemented.
-/

open algebra

/-- `D : derivation R A M` is an `R`-linear map from `A` to `M` that satisfies the `leibniz`
equality.
TODO: update this when bimodules are defined. -/
@[protect_proj]
structure derivation (R : Type*) (A : Type*) [comm_semiring R] [comm_semiring A]
  [algebra R A] (M : Type*) [add_cancel_comm_monoid M] [module A M] [module R M]
  [is_scalar_tower R A M]
  extends A →ₗ[R] M :=
(leibniz' (a b : A) : to_fun (a * b) = a • to_fun b + b • to_fun a)

/-- The `linear_map` underlying a `derivation`. -/
add_decl_doc derivation.to_linear_map

namespace derivation

section

variables {R : Type*} [comm_semiring R]
variables {A : Type*} [comm_semiring A] [algebra R A]
variables {M : Type*} [add_cancel_comm_monoid M] [module A M] [module R M]
variables [is_scalar_tower R A M]
variables (D : derivation R A M) {D1 D2 : derivation R A M} (r : R) (a b : A)

instance : has_coe_to_fun (derivation R A M) (λ _, A → M) := ⟨λ D, D.to_linear_map.to_fun⟩

instance has_coe_to_linear_map : has_coe (derivation R A M) (A →ₗ[R] M) :=
⟨λ D, D.to_linear_map⟩

@[simp] lemma to_linear_map_eq_coe : D.to_linear_map = D := rfl

@[simp] lemma mk_coe (f : A →ₗ[R] M) (h) :
  ((⟨f, h⟩ : derivation R A M) : A → M) = f := rfl

@[simp, norm_cast]
lemma coe_fn_coe (f : derivation R A M) : ⇑(f : A →ₗ[R] M) = f := rfl

lemma coe_injective : @function.injective (derivation R A M) (A → M) coe_fn :=
λ D1 D2 h, by { rcases D1 with ⟨⟨⟩⟩, rcases D2 with ⟨⟨⟩⟩, congr', }

@[ext] theorem ext (H : ∀ a, D1 a = D2 a) : D1 = D2 :=
coe_injective $ funext H

lemma congr_fun (h : D1 = D2) (a : A) : D1 a = D2 a := congr_fun (congr_arg coe_fn h) a

@[simp] lemma map_add : D (a + b) = D a + D b := linear_map.map_add D a b
@[simp] lemma map_zero : D 0 = 0 := linear_map.map_zero D
@[simp] lemma map_smul : D (r • a) = r • D a := linear_map.map_smul D r a
@[simp] lemma leibniz : D (a * b) = a • D b + b • D a := D.leibniz' _ _

@[simp] lemma map_one_eq_zero : D 1 = 0 :=
begin
  have h : D 1 = D (1 * 1) := by rw mul_one,
  rwa [leibniz D 1 1, one_smul, self_eq_add_right] at h
end

@[simp] lemma map_algebra_map : D (algebra_map R A r) = 0 :=
by rw [←mul_one r, ring_hom.map_mul, ring_hom.map_one, ←smul_def, map_smul, map_one_eq_zero,
  smul_zero]

@[simp] lemma leibniz_pow (n : ℕ) : D (a ^ n) = n • a ^ (n - 1) • D a :=
begin
  induction n with n ihn,
  { rw [pow_zero, map_one_eq_zero, zero_smul] },
  { rcases (zero_le n).eq_or_lt with (rfl|hpos),
    { rw [pow_one, one_smul, pow_zero, one_smul] },
    { have : a * a ^ (n - 1) = a ^ n, by rw [← pow_succ, nat.sub_add_cancel hpos],
      simp only [pow_succ, leibniz, ihn, smul_comm a n, smul_smul a, add_smul, this,
        nat.succ_eq_add_one, nat.add_succ_sub_one, add_zero, one_nsmul] } }
end

lemma eq_on_adjoin {s : set A} (h : set.eq_on D1 D2 s) : set.eq_on D1 D2 (adjoin R s) :=
λ x hx, algebra.adjoin_induction hx h
  (λ r, (D1.map_algebra_map r).trans (D2.map_algebra_map r).symm)
  (λ x y hx hy, by simp only [map_add, *])
  (λ x y hx hy, by simp only [leibniz, *])

/-- If adjoin of a set is the whole algebra, then any two derivations equal on this set are equal
on the whole algebra. -/
lemma ext_of_adjoin_eq_top (s : set A) (hs : adjoin R s = ⊤) (h : set.eq_on D1 D2 s) : D1 = D2 :=
ext $ λ a, eq_on_adjoin h $ hs.symm ▸ trivial

/- Data typeclasses -/

instance : has_zero (derivation R A M) :=
⟨{ leibniz' := λ a b, by simp only [add_zero, linear_map.zero_apply, linear_map.to_fun_eq_coe,
     smul_zero],
   ..(0 : A →ₗ[R] M) }⟩

@[simp] lemma coe_zero : ⇑(0 : derivation R A M) = 0 := rfl
@[simp] lemma coe_zero_linear_map : ↑(0 : derivation R A M) = (0 : A →ₗ[R] M) := rfl
lemma zero_apply (a : A) : (0 : derivation R A M) a = 0 := rfl

instance : has_add (derivation R A M) :=
⟨λ D1 D2, { leibniz' := λ a b, by simp only [leibniz, linear_map.add_apply,
              linear_map.to_fun_eq_coe, coe_fn_coe, smul_add, add_add_add_comm],
            ..(D1 + D2 : A →ₗ[R] M) }⟩

@[simp] lemma coe_add (D1 D2 : derivation R A M) : ⇑(D1 + D2) = D1 + D2 := rfl
@[simp] lemma coe_add_linear_map (D1 D2 : derivation R A M) : ↑(D1 + D2) = (D1 + D2 : A →ₗ[R] M) :=
rfl
lemma add_apply : (D1 + D2) a = D1 a + D2 a := rfl

instance Rscalar : has_scalar R (derivation R A M) :=
⟨λ r D, { leibniz' := λ a b, by simp only [linear_map.smul_apply, leibniz,
            linear_map.to_fun_eq_coe, smul_algebra_smul_comm, coe_fn_coe, smul_add, add_comm],
          ..(r • D : A →ₗ[R] M) }⟩

@[simp] lemma coe_Rsmul (r : R) (D : derivation R A M) : ⇑(r • D) = r • D := rfl
@[simp] lemma coe_Rsmul_linear_map (r : R) (D : derivation R A M) :
  ↑(r • D) = (r • D : A →ₗ[R] M) := rfl
lemma Rsmul_apply (r : R) (D : derivation R A M) : (r • D) a = r • D a := rfl

instance has_scalar : has_scalar A (derivation R A M) :=
⟨λ a D, { leibniz' := λ b c, by
          { dsimp, simp only [smul_add, leibniz, smul_comm a, add_comm] },
          ..(a • D : A →ₗ[R] M) }⟩

@[simp] lemma coe_smul (a : A) (D : derivation R A M) : ⇑(a • D) = a • D := rfl
@[simp] lemma coe_smul_linear_map (a : A) (D : derivation R A M) :
  ↑(a • D) = (a • D : A →ₗ[R] M) := rfl
lemma smul_apply (a : A) (D : derivation R A M) (b : A) : (a • D) b = a • D b := rfl

instance : inhabited (derivation R A M) := ⟨0⟩

instance : add_comm_monoid (derivation R A M) :=
coe_injective.add_comm_monoid _ coe_zero coe_add

/-- `coe_fn` as an `add_monoid_hom`. -/
def coe_fn_add_monoid_hom : derivation R A M →+ (A → M) :=
{ to_fun := coe_fn, map_zero' := coe_zero, map_add' := coe_add }

@[priority 100]
instance derivation.Rmodule : module R (derivation R A M) :=
function.injective.module R coe_fn_add_monoid_hom coe_injective coe_Rsmul

instance : module A (derivation R A M) :=
function.injective.module A coe_fn_add_monoid_hom coe_injective coe_smul

instance : is_scalar_tower R A (derivation R A M) :=
⟨λ x y z, ext (λ a, smul_assoc _ _ _)⟩

section push_forward

variables {N : Type*} [add_cancel_comm_monoid N] [module A N] [module R N] [is_scalar_tower R A N]
variables (f : M →ₗ[A] N)

/-- We can push forward derivations using linear maps, i.e., the composition of a derivation with a
linear map is a derivation. Furthermore, this operation is linear on the spaces of derivations. -/
def _root_.linear_map.comp_der : derivation R A M →ₗ[R] derivation R A N :=
{ to_fun    := λ D,
  { leibniz'  := λ a b, by simp only [coe_fn_coe, function.comp_app, linear_map.coe_comp,
                      linear_map.map_add, leibniz, linear_map.coe_coe_is_scalar_tower,
                      linear_map.map_smul, linear_map.to_fun_eq_coe],
    .. (f : M →ₗ[R] N).comp (D : A →ₗ[R] M), },
  map_add'  := λ D₁ D₂, by { ext, exact linear_map.map_add _ _ _, },
  map_smul' := λ r D, by { ext, exact linear_map.map_smul _ _ _, }, }

@[simp] lemma coe_to_linear_map_comp :
  (f.comp_der D : A →ₗ[R] N) = (f : M →ₗ[R] N).comp (D : A →ₗ[R] M) :=
rfl

@[simp] lemma coe_comp :
  (f.comp_der D : A → N) = (f : M →ₗ[R] N).comp (D : A →ₗ[R] M) :=
rfl

end push_forward

end

section

variables {R : Type*} [comm_ring R]
variables {A : Type*} [comm_ring A] [algebra R A]

section

variables {M : Type*} [add_comm_group M] [module A M] [module R M] [is_scalar_tower R A M]
variables (D : derivation R A M) {D1 D2 : derivation R A M} (r : R) (a b : A)

@[simp] lemma map_neg : D (-a) = -D a := linear_map.map_neg D a
@[simp] lemma map_sub : D (a - b) = D a - D b := linear_map.map_sub D a b

lemma leibniz_of_mul_eq_one {a b : A} (h : a * b = 1) : D a = -a^2 • D b :=
begin
  rw neg_smul,
  refine eq_neg_of_add_eq_zero _,
  calc D a + a ^ 2 • D b = a • b • D a + a • a • D b : by simp only [smul_smul, h, one_smul, sq]
                     ... = a • D (a * b)             : by rw [leibniz, smul_add, add_comm]
                     ... = 0                         : by rw [h, map_one_eq_zero, smul_zero]
end

lemma leibniz_inv_of [invertible a] : D (⅟a) = -⅟a^2 • D a :=
D.leibniz_of_mul_eq_one $ inv_of_mul_self a

lemma leibniz_inv {K : Type*} [field K] [module K M] [algebra R K] [is_scalar_tower R K M]
  (D : derivation R K M) (a : K) : D (a⁻¹) = -a⁻¹ ^ 2 • D a :=
begin
  rcases eq_or_ne a 0 with (rfl|ha),
  { simp },
  { exact D.leibniz_of_mul_eq_one (inv_mul_cancel ha) }
end

instance : has_neg (derivation R A M) :=
⟨λ D, { leibniz' := λ a b, by simp only [linear_map.neg_apply, smul_neg, neg_add_rev, leibniz,
          linear_map.to_fun_eq_coe, coe_fn_coe, add_comm],
        ..(-D : A →ₗ[R] M)}⟩

@[simp] lemma coe_neg (D : derivation R A M) : ⇑(-D) = -D := rfl
@[simp] lemma coe_neg_linear_map (D : derivation R A M) : ↑(-D) = (-D : A →ₗ[R] M) :=
rfl
lemma neg_apply : (-D) a = -D a := rfl

instance : has_sub (derivation R A M) :=
⟨λ D1 D2, { leibniz' := λ a b, by { simp only [linear_map.to_fun_eq_coe, linear_map.sub_apply,
              leibniz, coe_fn_coe, smul_sub], abel },
            ..(D1 - D2 : A →ₗ[R] M)}⟩

@[simp] lemma coe_sub (D1 D2 : derivation R A M) : ⇑(D1 - D2) = D1 - D2 := rfl
@[simp] lemma coe_sub_linear_map (D1 D2 : derivation R A M) : ↑(D1 - D2) = (D1 - D2 : A →ₗ[R] M) :=
rfl
lemma sub_apply : (D1 - D2) a = D1 a - D2 a := rfl

instance : add_comm_group (derivation R A M) :=
coe_injective.add_comm_group _ coe_zero coe_add coe_neg coe_sub

end

section lie_structures

/-! # Lie structures -/

variables (D : derivation R A A) {D1 D2 : derivation R A A} (r : R) (a b : A)

/-- The commutator of derivations is again a derivation. -/
instance : has_bracket (derivation R A A) (derivation R A A) :=
⟨λ D1 D2, { leibniz' := λ a b, by
            { simp only [ring.lie_def, map_add, id.smul_eq_mul, linear_map.mul_apply, leibniz,
                        linear_map.to_fun_eq_coe, coe_fn_coe, linear_map.sub_apply], ring, },
            to_linear_map := ⁅(D1 : module.End R A), (D2 : module.End R A)⁆, }⟩

@[simp] lemma commutator_coe_linear_map :
  ↑⁅D1, D2⁆ = ⁅(D1 : module.End R A), (D2 : module.End R A)⁆ := rfl

lemma commutator_apply : ⁅D1, D2⁆ a = D1 (D2 a) - D2 (D1 a) := rfl

instance : lie_ring (derivation R A A) :=
{ add_lie     := λ d e f, by { ext a, simp only [commutator_apply, add_apply, map_add], ring, },
  lie_add     := λ d e f, by { ext a, simp only [commutator_apply, add_apply, map_add], ring, },
  lie_self    := λ d, by { ext a, simp only [commutator_apply, add_apply, map_add], ring_nf, },
  leibniz_lie := λ d e f,
    by { ext a, simp only [commutator_apply, add_apply, sub_apply, map_sub], ring, } }

instance : lie_algebra R (derivation R A A) :=
{ lie_smul := λ r d e, by { ext a, simp only [commutator_apply, map_smul, smul_sub, Rsmul_apply]},
  ..derivation.Rmodule }

end lie_structures

end

end derivation


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

! This file was ported from Lean 3 source module algebra.continued_fractions.computation.approximation_corollaries
! leanprover-community/mathlib commit 2738d2ca56cbc63be80c3bd48e9ed90ad94e947d
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.ContinuedFractions.Computation.Approximations
import Mathbin.Algebra.ContinuedFractions.ConvergentsEquiv
import Mathbin.Algebra.Order.Archimedean
import Mathbin.Topology.Algebra.Order.Field

/-!
# Corollaries From Approximation Lemmas (`algebra.continued_fractions.computation.approximations`)

## Summary

We show that the generalized_continued_fraction given by `generalized_continued_fraction.of` in fact
is a (regular) continued fraction. Using the equivalence of the convergents computations
(`generalized_continued_fraction.convergents` and `generalized_continued_fraction.convergents'`) for
continued fractions (see `algebra.continued_fractions.convergents_equiv`), it follows that the
convergents computations for `generalized_continued_fraction.of` are equivalent.

Moreover, we show the convergence of the continued fractions computations, that is
`(generalized_continued_fraction.of v).convergents` indeed computes `v` in the limit.

## Main Definitions

- `continued_fraction.of` returns the (regular) continued fraction of a value.

## Main Theorems

- `generalized_continued_fraction.of_convergents_eq_convergents'` shows that the convergents
  computations for `generalized_continued_fraction.of` are equivalent.
- `generalized_continued_fraction.of_convergence` shows that
  `(generalized_continued_fraction.of v).convergents` converges to `v`.

## Tags

convergence, fractions
-/

variable {K : Type _} (v : K) [LinearOrderedField K] [FloorRing K]

open GeneralizedContinuedFraction (of)

open GeneralizedContinuedFraction

theorem GeneralizedContinuedFraction.of_isSimpleContinuedFraction :
    (of v).IsSimpleContinuedFraction := fun _ _ nth_part_num_eq =>
  of_part_num_eq_one nth_part_num_eq
#align generalized_continued_fraction.of_is_simple_continued_fraction GeneralizedContinuedFraction.of_isSimpleContinuedFraction

/-- Creates the simple continued fraction of a value. -/
def SimpleContinuedFraction.of : SimpleContinuedFraction K :=
  ⟨of v, GeneralizedContinuedFraction.of_isSimpleContinuedFraction v⟩
#align simple_continued_fraction.of SimpleContinuedFraction.of

theorem SimpleContinuedFraction.of_isContinuedFraction :
    (SimpleContinuedFraction.of v).IsContinuedFraction := fun _ denom nth_part_denom_eq =>
  lt_of_lt_of_le zero_lt_one (of_one_le_nth_part_denom nth_part_denom_eq)
#align simple_continued_fraction.of_is_continued_fraction SimpleContinuedFraction.of_isContinuedFraction

/-- Creates the continued fraction of a value. -/
def ContinuedFraction.of : ContinuedFraction K :=
  ⟨SimpleContinuedFraction.of v, SimpleContinuedFraction.of_isContinuedFraction v⟩
#align continued_fraction.of ContinuedFraction.of

namespace GeneralizedContinuedFraction

theorem of_convergents_eq_convergents' : (of v).convergents = (of v).convergents' :=
  @ContinuedFraction.convergents_eq_convergents' _ _ (ContinuedFraction.of v)
#align generalized_continued_fraction.of_convergents_eq_convergents' GeneralizedContinuedFraction.of_convergents_eq_convergents'

/-- The recurrence relation for the `convergents` of the continued fraction expansion
of an element `v` of `K` in terms of the convergents of the inverse of its fractional part.
-/
theorem convergents_succ (n : ℕ) :
    (of v).convergents (n + 1) = ⌊v⌋ + 1 / (of (Int.fract v)⁻¹).convergents n := by
  rw [of_convergents_eq_convergents', convergents'_succ, of_convergents_eq_convergents']
#align generalized_continued_fraction.convergents_succ GeneralizedContinuedFraction.convergents_succ

section Convergence

/-!
### Convergence

We next show that `(generalized_continued_fraction.of v).convergents v` converges to `v`.
-/

variable [Archimedean K]

open Nat

theorem of_convergence_epsilon : ∀ ε > (0 : K), ∃ N : ℕ, ∀ n ≥ N, |v - (of v).convergents n| < ε :=
  by
  intro ε ε_pos
  -- use the archimedean property to obtian a suitable N
  rcases(exists_nat_gt (1 / ε) : ∃ N' : ℕ, 1 / ε < N') with ⟨N', one_div_ε_lt_N'⟩
  let N := max N' 5
  -- set minimum to 5 to have N ≤ fib N work
  exists N
  intro n n_ge_N
  let g := of v
  cases' Decidable.em (g.terminated_at n) with terminated_at_n not_terminated_at_n
  · have : v = g.convergents n := of_correctness_of_terminated_at terminated_at_n
    have : v - g.convergents n = 0 := sub_eq_zero.elim_right this
    rw [this]
    exact_mod_cast ε_pos
  · let B := g.denominators n
    let nB := g.denominators (n + 1)
    have abs_v_sub_conv_le : |v - g.convergents n| ≤ 1 / (B * nB) :=
      abs_sub_convergents_le not_terminated_at_n
    suffices : 1 / (B * nB) < ε
    exact lt_of_le_of_lt abs_v_sub_conv_le this
    -- show that `0 < (B * nB)` and then multiply by `B * nB` to get rid of the division
    have nB_ineq : (fib (n + 2) : K) ≤ nB :=
      haveI : ¬g.terminated_at (n + 1 - 1) := not_terminated_at_n
      succ_nth_fib_le_of_nth_denom (Or.inr this)
    have B_ineq : (fib (n + 1) : K) ≤ B :=
      haveI : ¬g.terminated_at (n - 1) := mt (terminated_stable n.pred_le) not_terminated_at_n
      succ_nth_fib_le_of_nth_denom (Or.inr this)
    have zero_lt_B : 0 < B :=
      haveI : (0 : K) < fib (n + 1) := by exact_mod_cast fib_pos n.zero_lt_succ
      lt_of_lt_of_le this B_ineq
    have zero_lt_mul_conts : 0 < B * nB :=
      by
      have : 0 < nB :=
        haveI : (0 : K) < fib (n + 2) := by exact_mod_cast fib_pos (n + 1).zero_lt_succ
        lt_of_lt_of_le this nB_ineq
      solve_by_elim [mul_pos]
    suffices : 1 < ε * (B * nB)
    exact (div_lt_iff zero_lt_mul_conts).right this
    -- use that `N ≥ n` was obtained from the archimedean property to show the following
    have one_lt_ε_mul_N : 1 < ε * n :=
      by
      have one_lt_ε_mul_N' : 1 < ε * (N' : K) := (div_lt_iff' ε_pos).left one_div_ε_lt_N'
      have : (N' : K) ≤ N := by exact_mod_cast le_max_left _ _
      have : ε * N' ≤ ε * n :=
        (mul_le_mul_left ε_pos).right (le_trans this (by exact_mod_cast n_ge_N))
      exact lt_of_lt_of_le one_lt_ε_mul_N' this
    suffices : ε * n ≤ ε * (B * nB)
    exact lt_of_lt_of_le one_lt_ε_mul_N this
    -- cancel `ε`
    suffices : (n : K) ≤ B * nB
    exact (mul_le_mul_left ε_pos).right this
    show (n : K) ≤ B * nB
    calc
      (n : K) ≤ fib n := by exact_mod_cast le_fib_self <| le_trans (le_max_right N' 5) n_ge_N
      _ ≤ fib (n + 1) := by exact_mod_cast fib_le_fib_succ
      _ ≤ fib (n + 1) * fib (n + 1) := by exact_mod_cast (fib (n + 1)).le_mul_self
      _ ≤ fib (n + 1) * fib (n + 2) :=
        (mul_le_mul_of_nonneg_left (by exact_mod_cast fib_le_fib_succ)
          (by exact_mod_cast (fib (n + 1)).zero_le))
      _ ≤ B * nB :=
        mul_le_mul B_ineq nB_ineq (by exact_mod_cast (fib (n + 2)).zero_le) (le_of_lt zero_lt_B)

#align generalized_continued_fraction.of_convergence_epsilon GeneralizedContinuedFraction.of_convergence_epsilon

attribute [local instance] Preorder.topology

theorem of_convergence [OrderTopology K] :
    Filter.Tendsto (of v).convergents Filter.atTop <| nhds v := by
  simpa [LinearOrderedAddCommGroup.tendsto_nhds, abs_sub_comm] using of_convergence_epsilon v
#align generalized_continued_fraction.of_convergence GeneralizedContinuedFraction.of_convergence

end Convergence

end GeneralizedContinuedFraction


/-
Copyright (c) 2021 Oliver Nash. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Oliver Nash
-/
import data.nat.choose.sum
import algebra.algebra.bilinear
import ring_theory.ideal.operations

/-!
# Nilpotent elements

## Main definitions

  * `is_nilpotent`
  * `is_nilpotent_neg_iff`
  * `commute.is_nilpotent_add`
  * `commute.is_nilpotent_mul_left`
  * `commute.is_nilpotent_mul_right`
  * `commute.is_nilpotent_sub`

-/

universes u v

variables {R : 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
`monoid_with_zero` is too strong since nilpotency is important in the study of rings that are only
power-associative. -/
def is_nilpotent [has_zero R] [has_pow R ℕ] (x : R) : Prop := ∃ (n : ℕ), x^n = 0

lemma is_nilpotent.zero [monoid_with_zero R] : is_nilpotent (0 : R) := ⟨1, pow_one 0⟩

lemma is_nilpotent.neg [ring R] (h : is_nilpotent x) : is_nilpotent (-x) :=
begin
  obtain ⟨n, hn⟩ := h,
  use n,
  rw [neg_pow, hn, mul_zero],
end

@[simp] lemma is_nilpotent_neg_iff [ring R] : is_nilpotent (-x) ↔ is_nilpotent x :=
⟨λ h, neg_neg x ▸ h.neg, λ h, h.neg⟩

/-- A structure that has zero and pow is reduced if it has no nonzero nilpotent elements. -/
class is_reduced (R : Type*) [has_zero R] [has_pow R ℕ] : Prop :=
(eq_zero : ∀ (x : R), is_nilpotent x → x = 0)

@[priority 900]
instance is_reduced_of_no_zero_divisors [monoid_with_zero R] [no_zero_divisors R] : is_reduced R :=
⟨λ _ ⟨_, hn⟩, pow_eq_zero hn⟩

lemma is_nilpotent.eq_zero [has_zero R] [has_pow R ℕ] [is_reduced R]
  (h : is_nilpotent x) : x = 0 :=
is_reduced.eq_zero x h

@[simp] lemma is_nilpotent_iff_eq_zero [monoid_with_zero R] [is_reduced R] :
  is_nilpotent x ↔ x = 0 :=
⟨λ h, h.eq_zero, λ h, h.symm ▸ is_nilpotent.zero⟩

namespace commute

section semiring

variables [semiring R] (h_comm : commute x y)

include h_comm

lemma is_nilpotent_mul_left (h : is_nilpotent x) : is_nilpotent (x * y) :=
begin
  obtain ⟨n, hn⟩ := h,
  use n,
  rw [h_comm.mul_pow, hn, zero_mul],
end

lemma is_nilpotent_mul_right (h : is_nilpotent y) : is_nilpotent (x * y) :=
by { rw h_comm.eq, exact h_comm.symm.is_nilpotent_mul_left h, }

end semiring

section ring

variables [ring R] (h_comm : commute x y)

include h_comm

lemma is_nilpotent_sub (hx : is_nilpotent x) (hy : is_nilpotent y) : is_nilpotent (x - y) :=
begin
  rw ← neg_right_iff at h_comm,
  rw ← is_nilpotent_neg_iff at hy,
  rw sub_eq_add_neg,
  exact h_comm.is_nilpotent_add hx hy,
end

end ring

end commute

section comm_semiring

variable [comm_semiring R]

/-- The nilradical of a commutative semiring is the ideal of nilpotent elements. -/
def nilradical (R : Type*) [comm_semiring R] : ideal R := (0 : ideal R).radical

lemma mem_nilradical : x ∈ nilradical R ↔ is_nilpotent x := iff.rfl

lemma nilradical_eq_Inf (R : Type*) [comm_semiring R] :
  nilradical R = Inf { J : ideal R | J.is_prime } :=
by { convert ideal.radical_eq_Inf 0, simp }

lemma nilpotent_iff_mem_prime : is_nilpotent x ↔ ∀ (J : ideal R), J.is_prime → x ∈ J :=
by { rw [← mem_nilradical, nilradical_eq_Inf, submodule.mem_Inf], refl }

lemma nilradical_le_prime (J : ideal R) [H : J.is_prime] : nilradical R ≤ J :=
(nilradical_eq_Inf R).symm ▸ Inf_le H

@[simp] lemma nilradical_eq_zero (R : Type*) [comm_semiring R] [is_reduced R] : nilradical R = 0 :=
ideal.ext $ λ _, is_nilpotent_iff_eq_zero

end comm_semiring

namespace algebra

variables (R) {A : Type v} [comm_semiring R] [semiring A] [algebra R A]

@[simp] lemma is_nilpotent_lmul_left_iff (a : A) :
  is_nilpotent (lmul_left R a) ↔ is_nilpotent a :=
begin
  split; rintros ⟨n, hn⟩; use n;
  simp only [lmul_left_eq_zero_iff, pow_lmul_left] at ⊢ hn;
  exact hn,
end

@[simp] lemma is_nilpotent_lmul_right_iff (a : A) :
  is_nilpotent (lmul_right R a) ↔ is_nilpotent a :=
begin
  split; rintros ⟨n, hn⟩; use n;
  simp only [lmul_right_eq_zero_iff, pow_lmul_right] at ⊢ hn;
  exact hn,
end

end algebra


import util.logic
import util.data.nat

open nat

universe variables u v

variables {α : Type u} {β : Type v}

lemma fin.veq_def {n} (x y : fin n)
: x = y ↔ x.val = y.val :=
begin
  split,
  apply fin.veq_of_eq,
  apply fin.eq_of_veq,
end

instance {n : ℕ} : inhabited (fin (succ n)) :=
inhabited.mk ⟨n,lt_succ_self _⟩

lemma fin.zero_def (n : ℕ)
: (0 : fin (succ n)).val = 0 :=
by refl

lemma fin.zero_def' (n : ℕ)
: (0 : fin (succ n)) = ⟨0, zero_lt_succ _ ⟩ :=
by { apply fin.eq_of_veq, rw fin.zero_def }

lemma fin.all_eq_zero (x : fin 1)
: x = 0 :=
by { cases x, cases x_val, refl, cases x_is_lt with i h, cases h, }

def fin.next {n : ℕ} : fin n → fin (succ n)
  | ⟨i,P⟩ := ⟨succ i, succ_lt_succ P⟩

def fin.pred' {n} : fin n → fin n
  | ⟨i,P⟩ := ⟨pred i,lt_of_le_of_lt (pred_le _) P⟩

def fin.succ' {n} : fin n → fin n
  | ⟨i,P⟩ := if P' : succ i < n then ⟨succ i,P'⟩
                                else ⟨i,P⟩

lemma fin.val_succ_le_nat_succ {n : ℕ} (x : fin n)
: x.succ'.val ≤ succ (x.val) :=
begin
  cases n with n
  ; cases x with x Pn
  ; unfold fin.succ' fin.val,
  { cases not_lt_zero _ Pn },
  cases decidable.em (succ x < succ n) with h h,
  { rw dif_pos h },
  { rw dif_neg h,
    apply le_succ },
end

lemma fin.pred_def {n : ℕ} (x : fin n)
: x.pred'.val = pred x.val :=
begin
  cases x with x Px,
  refl
end

lemma fin.succ_def  {n : ℕ} (x : fin n)
  (h : succ x.val < n)
: (x.succ').val = succ x.val :=
begin
  cases x with x Px,
  unfold fin.succ' fin.val,
  unfold fin.val at h,
  rw dif_pos h,
end

def fin.max {n} : fin (succ n) := ⟨n,lt_succ_self _⟩

lemma fin.max_def {n}
: (@fin.max n).val = n := rfl

lemma fin.pred_succ' {n} (x : fin n)
  (h : succ x.val < n)
: x.succ'.pred' = x :=
begin
  apply fin.eq_of_veq,
  rw [fin.pred_def,fin.succ_def,pred_succ],
  apply h,
end

lemma fin.succ_pred' {n} (x : fin (succ n))
  (h : 0 < x)
: x.pred'.succ' = x :=
begin
  apply fin.eq_of_veq,
  have h' : 0 < x.val,
  { rw [fin.lt_def,fin.zero_def] at h,
    apply h },
  rw [fin.succ_def,fin.pred_def,succ_pred_eq_of_pos h'],
  rw [fin.pred_def,succ_pred_eq_of_pos h'],
  apply x.is_lt,
end

lemma fin.succ_le_self {n} (x : fin (succ n))
  (h : x < fin.max)
: ¬ x.succ' ≤ x :=
begin
  rw [fin.le_def,fin.succ_def],
  apply not_succ_le_self,
  apply succ_lt_succ,
  rw [fin.lt_def,fin.max_def] at h,
  apply h
end

lemma fin.le_succ_self {n} (x : fin (succ n))
: x ≤ x.succ' :=
begin
  cases x with x Px,
  unfold fin.succ',
  cases decidable.em (succ x < succ n) with h h,
  { rw [dif_pos h,fin.le_def],
    apply le_succ },
  { rw [dif_neg h,fin.le_def], },
end

lemma fin.eq_zero_of_val_le_zero {n} (x : fin (succ n))
  (h : x.val ≤ 0)
: x = 0 :=
begin
  apply fin.eq_of_veq,
  rw fin.zero_def,
  apply le_antisymm h,
  apply nat.zero_le
end

lemma fin.val_injective {n} : function.injective (@fin.val n)
 | ⟨x,_⟩ ⟨.(x),_⟩ rfl := rfl

def widen {n} : fin n → fin (nat.succ n)
| ⟨i,P⟩ := ⟨i,nat.le_succ_of_le P⟩

def restr {n α} (f : fin (nat.succ n) → α) (x : fin n) : α :=
f (widen x)

lemma widen_val {n : ℕ} (x : fin n)
: (widen x).val = x.val :=
by { cases x, refl }

lemma forall_fin_zero_iff_true (p : fin 0 → Prop)
: (∀ i, p i) ↔ true :=
begin
  split,
  { intros, trivial },
  { intros h' i, apply fin.elim0 i }
end

lemma forall_split_one {n : ℕ} (p : fin (nat.succ n) → Prop)
: (∀ i, p i) ↔ p fin.max ∧ (∀ i, restr p i) :=
begin
  split ; intro h,
  split,
  { apply h },
  { intro, apply h },
  { intro i, cases i with i hi,
    cases (lt_or_eq_of_le $ le_of_lt_succ hi) with h₀ h₁,
    { apply h.right ⟨i,h₀⟩ },
    { subst i, apply h.left } },
end

lemma exists_split_one {n : ℕ} (p : fin (nat.succ n) → Prop)
: (∃ i, p i) ↔ p fin.max ∨ (∃ i, restr p i) :=
begin
  rw [← not_iff_not_iff],
  simp [not_or_iff_not_and_not,not_exists_iff_forall_not,forall_split_one],
  refl
end

def fin.nest' {n m : ℕ} (H : m ≤ n) : fin m → fin n
  | ⟨i,P⟩ := ⟨i,lt_of_lt_of_le P H⟩

lemma fin.nest'_injective {n m : ℕ} (H : m ≤ n)
: function.injective (fin.nest' H) :=
begin
  intros i j,
  cases i with i Hi, cases j with j Hj,
  unfold fin.nest',
  intros H,
  apply fin.eq_of_veq, unfold fin.val,
  apply fin.veq_of_eq H,
end

def fin.nest {n m : ℕ} : fin m → fin (m + n)
  | ⟨i,P⟩ := ⟨i,lt_of_lt_of_le P (le_add_right m n)⟩

def fin.shift {n m : ℕ} : fin n → fin (m + n)
  | ⟨i,P⟩ := ⟨m+i,add_lt_add_left P _⟩

def fin.split {n m : ℕ} : fin (m + n) → fin m ⊕ fin n
  | ⟨k,P⟩ :=
if h : k < m
  then sum.inl ⟨k,h⟩
  else
    have h₀ : n = (m + n) - m, by rw nat.add_sub_cancel_left,
    have h₁ : k - m < n,
         begin rw h₀,
               apply nat.sub_lt_sub_right _ P,
               apply le_of_not_gt h
         end,
    sum.inr ⟨k-m,h₁⟩

def fin.unsplit {n m : ℕ} : fin m ⊕ fin n → fin (m + n)
  | (sum.inl n) := fin.nest n
  | (sum.inr n) := fin.shift n

lemma fin.split_nest {n m : ℕ} (k : fin m)
: fin.split (@fin.nest n m k) = sum.inl k :=
begin
  cases k with k Hk,
  unfold fin.shift fin.nest fin.split,
  rw dif_pos Hk
end

lemma fin.split_shift {n m : ℕ} (k : fin n)
: fin.split (@fin.shift n m k) = sum.inr k :=
begin
  cases k with k Hk,
  unfold fin.shift fin.nest fin.split,
  { have H : ¬ m + k < m,
    { apply not_lt_of_ge, apply nat.le_add_right },
    rw [dif_neg H],
    apply congr_arg,
    apply fin.eq_of_veq,
    unfold fin.val,
      -- simp, below, invokes two similar lemmas for the
      -- stability of the proof
    simp [nat.add_sub_cancel_left,nat.add_sub_cancel] },
end

lemma fin.split_unsplit {n m : ℕ} (k : fin m ⊕ fin n)
: fin.split (fin.unsplit k) = k :=
begin
  cases k with k k
  ; unfold fin.unsplit,
  { rw fin.split_nest },
  { rw fin.split_shift },
end

lemma fin.unsplit_split {n m : ℕ} (k : fin (m + n))
: fin.unsplit (fin.split k) = k :=
begin
  cases k with k Hk,
  cases classical.em (k < m) with h h
  ; unfold fin.split,
  { rw dif_pos h, unfold fin.unsplit fin.nest, },
  { rw dif_neg h,
    apply fin.eq_of_veq,
    unfold fin.unsplit fin.shift fin.val,
    rw [← nat.add_sub_assoc,nat.add_sub_cancel_left],
    apply le_of_not_gt h },
end

lemma fin.unsplit_eq_iff_eq_split {n m : ℕ} (p : fin m ⊕ fin n) (q : fin (m + n))
: fin.unsplit p = q ↔ p = fin.split q :=
begin
  split ; intro h,
  { rw [← h,fin.split_unsplit], },
  { rw [h,fin.unsplit_split], },
end

lemma fin.nest_eq_iff_eq_split {n m : ℕ} (p : fin m) (q : fin (m + n))
: fin.nest p = q ↔ sum.inl p = fin.split q :=
by { rw ← fin.unsplit_eq_iff_eq_split, refl }

lemma fin.shift_eq_iff_eq_split {n m : ℕ} (p : fin n) (q : fin (m + n))
: fin.shift p = q ↔ sum.inr p = fin.split q :=
by { rw ← fin.unsplit_eq_iff_eq_split, refl }

lemma fin.split_injective  {n m : ℕ} (p q : fin (m + n))
  (h : fin.split p = fin.split q)
: p = q :=
by { rw [← fin.unsplit_eq_iff_eq_split,fin.unsplit_split] at h, assumption }

lemma fin.val_shift_zero (m n : ℕ)
: (@fin.shift _ m (0 : fin (succ n))).val = m :=
rfl

lemma fin.shift_zero (m : ℕ)
: fin.max = (@fin.shift _ m (0 : fin 1)) :=
begin
  apply fin.eq_of_veq,
  unfold fin.shift fin.max, simp [fin.val_shift_zero],
end

lemma fin.val_of_nat_eq_mod (m n : ℕ)
: (@fin.of_nat m n).val = n % succ m :=
by refl

lemma fin.val_of_nat {m n : ℕ} (h : n < nat.succ m)
: (@fin.of_nat m n).val = n :=
by rw [fin.val_of_nat_eq_mod,mod_eq_of_lt h]

def fin.foldl {n : ℕ}
  (f : α → β → β) (x : β) (a : fin n → α) : β :=
array.foldl (d_array.mk a) x f

def fin.sum (n : ℕ)
  [has_add α] [has_zero α]
  (a : fin n → α) : α :=
fin.foldl has_add.add 0 a


mutual
  def isEven : Nat → Bool
    | 0 => true
    | n+1 => isOdd n
  def isOdd : Nat → Bool
    | 0 => false
    | n+1 => isEven n
end
termination_by' measure fun
  | Sum.inl n => n
  | Sum.inr n => n
decreasing_by
  simp [measure, invImage, InvImage, Nat.lt_wfRel]
  apply Nat.lt_succ_self

theorem isEven_double (x : Nat) : isEven (2 * x) = true := by
  induction x with
  | zero => simp
  | succ x ih => simp [Nat.mul_succ, Nat.add_succ, isEven, isOdd, ih]


import tactic -- hide
import data.real.basic -- hide
/-
## The `split` tactic

Sometimes the goal is a conjunction of two statements. It may be directly a `∧` (it is typed with `\and`),
or it may be secretely a conjuntion, like an if and only if statement (since `↔` (type it with `\iff`)
means `→` and `←`). In those cases, the `split` tactic will produce two goals.

If you don't do anything afterwards, you will be working on the first of the goals until you solve them,
and then you will work on the second, and so on. It is nicer, however, to isolate them using `{}` to separate
the different blocks. Below you can see an example (notice the commas!).
-/

example (a b : ℕ) (h1 : a = 3) (h2 : b = 5) : a = 3 ∧ b = 5 :=
begin
  split,
  {
    assumption,
  },
  {
    assumption,
  }
end

/- Symbol :
∧ : \and
-/
/- Lemma : no-side-bar
For every $x,y\in \mathbb{Z}$, we have $(x+y)^2 = x^2 + 2xy + y^2$ and $(x-y)^2 = x^2 - 2xy + y^2$.
-/
lemma sp0 (x y : ℤ) : (x+y)^2 = x^2 + 2*x*y + y^2 ∧ (x-y)^2 = x^2 - 2*x*y + y^2 :=
begin
  split,
  {
    ring,
  },
  {
    ring,
  }

end


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison.
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.tactic.apply_fun
import Mathlib.algebra.ordered_ring
import Mathlib.algebra.big_operators.basic
import Mathlib.data.equiv.ring
import Mathlib.PostPort

universes u l u_1

namespace Mathlib

/-!
# Star monoids and star rings

We introduce the basic algebraic notions of star monoids, and star rings.
Star algebras are introduced in `algebra.algebra.star`.

These are implemented as "mixin" typeclasses, so to summon a star ring (for example)
one needs to write `(R : Type) [ring R] [star_ring R]`.
This avoids difficulties with diamond inheritance.

For now we simply do not introduce notations,
as different users are expected to feel strongly about the relative merits of
`r^*`, `r†`, `rᘁ`, and so on.

Our star rings are actually star semirings, but of course we can prove
`star_neg : star (-r) = - star r` when the underlying semiring is a ring.
-/

/--
Notation typeclass (with no default notation!) for an algebraic structure with a star operation.
-/
class has_star (R : Type u) where
  star : R → R

/--
A star operation (e.g. complex conjugate).
-/
def star {R : Type u} [has_star R] (r : R) : R := has_star.star r

/--
Typeclass for a star operation with is involutive.
-/
class has_involutive_star (R : Type u) extends has_star R where
  star_involutive : function.involutive has_star.star

@[simp] theorem star_star {R : Type u} [has_involutive_star R] (r : R) : star (star r) = r :=
  has_involutive_star.star_involutive r

theorem star_injective {R : Type u} [has_involutive_star R] : function.injective star :=
  function.involutive.injective has_involutive_star.star_involutive

/--
A *-monoid is a monoid `R` with an involutive operations `star`
so `star (r * s) = star s * star r`.
-/
class star_monoid (R : Type u) [monoid R] extends has_involutive_star R where
  star_mul : ∀ (r s : R), has_star.star (r * s) = has_star.star s * has_star.star r

@[simp] theorem star_mul {R : Type u} [monoid R] [star_monoid R] (r : R) (s : R) :
    star (r * s) = star s * star r :=
  star_monoid.star_mul r s

/-- `star` as an `mul_equiv` from `R` to `Rᵒᵖ` -/
@[simp] theorem star_mul_equiv_apply {R : Type u} [monoid R] [star_monoid R] (x : R) :
    coe_fn star_mul_equiv x = opposite.op (star x) :=
  Eq.refl (coe_fn star_mul_equiv x)

@[simp] theorem star_one (R : Type u) [monoid R] [star_monoid R] : star 1 = 1 := sorry

/--
A *-ring `R` is a (semi)ring with an involutive `star` operation which is additive
which makes `R` with its multiplicative structure into a *-monoid
(i.e. `star (r * s) = star s * star r`).
-/
class star_ring (R : Type u) [semiring R] extends star_monoid R where
  star_add : ∀ (r s : R), has_star.star (r + s) = has_star.star r + has_star.star s

@[simp] theorem star_add {R : Type u} [semiring R] [star_ring R] (r : R) (s : R) :
    star (r + s) = star r + star s :=
  star_ring.star_add r s

/-- `star` as an `add_equiv` -/
def star_add_equiv {R : Type u} [semiring R] [star_ring R] : R ≃+ R :=
  add_equiv.mk star (equiv.inv_fun (function.involutive.to_equiv star sorry)) sorry sorry star_add

@[simp] theorem star_zero (R : Type u) [semiring R] [star_ring R] : star 0 = 0 :=
  add_equiv.map_zero star_add_equiv

/-- `star` as an `ring_equiv` from `R` to `Rᵒᵖ` -/
@[simp] theorem star_ring_equiv_apply {R : Type u} [semiring R] [star_ring R] (x : R) :
    coe_fn star_ring_equiv x = opposite.op (star x) :=
  Eq.refl (coe_fn star_ring_equiv x)

@[simp] theorem star_sum {R : Type u} [semiring R] [star_ring R] {α : Type u_1} (s : finset α)
    (f : α → R) : star (finset.sum s fun (x : α) => f x) = finset.sum s fun (x : α) => star (f x) :=
  add_equiv.map_sum star_add_equiv (fun (x : α) => f x) s

@[simp] theorem star_neg {R : Type u} [ring R] [star_ring R] (r : R) : star (-r) = -star r :=
  add_equiv.map_neg star_add_equiv r

@[simp] theorem star_sub {R : Type u} [ring R] [star_ring R] (r : R) (s : R) :
    star (r - s) = star r - star s :=
  add_equiv.map_sub star_add_equiv r s

@[simp] theorem star_bit0 {R : Type u} [ring R] [star_ring R] (r : R) :
    star (bit0 r) = bit0 (star r) :=
  sorry

@[simp] theorem star_bit1 {R : Type u} [ring R] [star_ring R] (r : R) :
    star (bit1 r) = bit1 (star r) :=
  sorry

/--
Any commutative semiring admits the trivial *-structure.
-/
def star_ring_of_comm {R : Type u_1} [comm_semiring R] : star_ring R := star_ring.mk sorry

@[simp] theorem star_id_of_comm {R : Type u_1} [comm_semiring R] {x : R} : star x = x := rfl

end Mathlib


import category_theory.category
import data.is_equiv
import data.bij_on

/-

The basic finite colimit notions: initial objects, (binary)
coproducts, coequalizers and pushouts.

For each notion X, we define three structures/classes:

* `Is_X`, parameterized by a cocone diagram (but not on the
  commutativity condition!), which describes the commutativity and the
  universal property of the cocone. For example, a value of type
  `Is_pushout f₀ f₁ g₀ g₁` represents the property that the square
  formed by the four morphisms commutes and is a pushout square.

  Each `Is_X` is a subsingleton, but not a Prop, because we want to be
  able to constructively obtain the morphisms whose existence is
  guaranteed by the universal property.

* `X`, parameterized by the "input diagram" for the corresponding sort
  of colimit, which contains the data of a colimit of that sort on
  that diagram. For example, `pushout f₀ f₁` consists of an object and
  two maps which form a pushout square together with the given maps f₀
  and f₁. These structures are not subsingletons, because colimits are
  unique only up to unique isomorphism. This structure exists mostly
  to be used in the corresponding `has_X` class.

* `has_X`, a class for categories, which contains the data of a choice
  of `X` for each possible "input diagram". Thus an instance of
  `has_pushouts` is a category with a specified choice of pushout
  cocone on each span. It is not a subsingleton for the same reason
  that `X` is not one.

The `has_X` classes are of obvious importance, but the `Is_X`
structures are also very useful, especially in settings where colimits
of type X are not known to exist a priori. For example, preservation
of colimits by functors (in the usual "up to isomorphism" sense, not
strictly preserving the chosen colimits) is naturally formulated in
terms of `Is_X`, as is the standard fact about gluing together pushout
squares.

We define the `Is_X` structures by directly encoding the universal
property using the `Is_equiv` type, a constructive version of
`bijective`. Not sure yet whether this has advantages. In any case we
provide an alternate "first-order" interface through `mk'`
constructors and lemmas.

-/

-- TODO: "first-order" lemmas for the other notions besides coequalizers

open category_theory.category
local notation f ` ∘ `:80 g:80 := g ≫ f

namespace category_theory
section

universes v u
parameters {C : Type u} [category.{v} C]

section initial_object

section Is
-- The putative initial object.
parameters {a : C}

-- An object is initial if for each x, the Hom set `a ⟶ x` is a
-- singleton.
def initial_object_comparison (x : C) : (a ⟶ x) → true :=
λ _, trivial

parameters (a)
-- The (constructive) property of being an initial object.
structure Is_initial_object : Type (max u v) :=
(universal : Π x, Is_equiv (initial_object_comparison x))

instance Is_initial_object.subsingleton : subsingleton Is_initial_object :=
⟨by intros p p'; cases p; cases p'; congr⟩

parameters {a}
-- Alternative verification of being an initial object.
def Is_initial_object.mk'
  (induced : Π {x}, a ⟶ x)
  (uniqueness : ∀ {x} (k k' : a ⟶ x), k = k') :
  Is_initial_object :=
{ universal := λ x,
  { e :=
    { to_fun := initial_object_comparison x,
      inv_fun := λ p, induced,
      left_inv := assume h, uniqueness _ _,
      right_inv := assume p, rfl },
    h := rfl } }

parameters (H : Is_initial_object)
def Is_initial_object.induced {x} : a ⟶ x :=
(H.universal x).e.symm trivial

def Is_initial_object.uniqueness {x} (k k' : a ⟶ x) : k = k' :=
(H.universal x).bijective.1 rfl

end Is

-- An initial object.
structure initial_object :=
(ob : C)
(is_initial_object : Is_initial_object ob)

parameters (C)
-- A choice of initial object. (This is basically the same as
-- initial_object, since there are no "parameters" in the definition
-- of an initial object.)
class has_initial_object :=
(initial_object : initial_object)

end initial_object

section coproduct

section Is
-- The putative coproduct diagram.
parameters {a₀ a₁ b : C} {f₀ : a₀ ⟶ b} {f₁ : a₁ ⟶ b}

-- The diagram above is a coproduct diagram when giving a map b ⟶ x is
-- the same as giving a map a₀ ⟶ x and a map a₁ ⟶ x.
def coproduct_comparison (x : C) : (b ⟶ x) → (a₀ ⟶ x) × (a₁ ⟶ x) :=
λ k, (k ∘ f₀, k ∘ f₁)

parameters (f₀ f₁)
-- The (constructive) property of being a coproduct.
structure Is_coproduct : Type (max u v) :=
(universal : Π x, Is_equiv (coproduct_comparison x))

instance Is_coproduct.subsingleton : subsingleton Is_coproduct :=
⟨by intros p p'; cases p; cases p'; congr⟩

parameters {f₀ f₁}
-- Alternative verification of being a coproduct.
def Is_coproduct.mk'
  (induced : Π {x} (h₀ : a₀ ⟶ x) (h₁ : a₁ ⟶ x), b ⟶ x)
  (induced_commutes₀ : ∀ {x} (h₀ : a₀ ⟶ x) (h₁ : a₁ ⟶ x), induced h₀ h₁ ∘ f₀ = h₀)
  (induced_commutes₁ : ∀ {x} (h₀ : a₀ ⟶ x) (h₁ : a₁ ⟶ x), induced h₀ h₁ ∘ f₁ = h₁)
  (uniqueness : ∀ {x} (k k' : b ⟶ x), k ∘ f₀ = k' ∘ f₀ → k ∘ f₁ = k' ∘ f₁ → k = k') :
  Is_coproduct :=
{ universal := λ x,
  { e :=
    { to_fun := coproduct_comparison x,
      inv_fun := λ p, induced p.1 p.2,
      left_inv := assume h, by
        apply uniqueness; rw induced_commutes₀ <|> rw induced_commutes₁; refl,
      right_inv := assume p, prod.ext
        (induced_commutes₀ p.1 p.2)
        (induced_commutes₁ p.1 p.2) },
    h := rfl } }

parameters (H : Is_coproduct)
def Is_coproduct.induced {x} (h₀ : a₀ ⟶ x) (h₁ : a₁ ⟶ x) : b ⟶ x :=
(H.universal x).e.inv_fun (h₀, h₁)

@[simp] lemma Is_coproduct.induced_commutes₀ {x} (h₀ : a₀ ⟶ x) (h₁ : a₁ ⟶ x) :
  H.induced h₀ h₁ ∘ f₀ = h₀ :=
congr_arg prod.fst (H.universal x).cancel_right

@[simp] lemma Is_coproduct.induced_commutes₁ {x} (h₀ : a₀ ⟶ x) (h₁ : a₁ ⟶ x) :
  H.induced h₀ h₁ ∘ f₁ = h₁ :=
congr_arg prod.snd (H.universal x).cancel_right

lemma Is_coproduct.uniqueness {x : C} {k k' : b ⟶ x}
  (e₀ : k ∘ f₀ = k' ∘ f₀) (e₁ : k ∘ f₁ = k' ∘ f₁) : k = k' :=
(H.universal x).bijective.1 (prod.ext e₀ e₁)

end Is

-- A coproduct of a given diagram.
structure coproduct (a₀ a₁ : C) :=
(ob : C)
(map₀ : a₀ ⟶ ob)
(map₁ : a₁ ⟶ ob)
(is_coproduct : Is_coproduct map₀ map₁)

parameters (C)
-- A choice of coproducts of all diagrams.
class has_coproducts :=
(coproduct : Π (a₀ a₁ : C), coproduct a₀ a₁)

end coproduct

section coequalizer

section Is
-- The putative coequalizer diagram. `commutes` is a `variable`
-- because we do not want to index `Is_coequalizer` on it.
parameters {a b c : C} {f₀ f₁ : a ⟶ b} {g : b ⟶ c}
variables (commutes : g ∘ f₀ = g ∘ f₁)

-- The diagram above is a coequalizer diagram when giving a map c ⟶ x
-- is the same as giving a map b ⟶ x whose two pullback to a ⟶ x
-- agree.
def coequalizer_comparison (x : C) : (c ⟶ x) → {h : b ⟶ x // h ∘ f₀ = h ∘ f₁} :=
λ k, ⟨k ∘ g, have _ := commutes, by rw [←assoc, ←assoc, this]⟩

parameters (f₀ f₁ g)
-- The (constructive) property of being a coequalizer diagram.
-- TODO: Rewrite this in the same way as Is_pushout, using Bij_on?
structure Is_coequalizer : Type (max u v) :=
(commutes : g ∘ f₀ = g ∘ f₁)
(universal : Π x, Is_equiv (coequalizer_comparison commutes x))

instance Is_coequalizer.subsingleton : subsingleton Is_coequalizer :=
⟨by intros p p'; cases p; cases p'; congr⟩

parameters {f₀ f₁ g}
-- Alternative verification of being a coequalizer.
def Is_coequalizer.mk'
  (induced : Π {x} (h : b ⟶ x), h ∘ f₀ = h ∘ f₁ → (c ⟶ x))
  (induced_commutes : ∀ {x} (h : b ⟶ x) (e), induced h e ∘ g = h)
  (uniqueness : ∀ {x} (k k' : c ⟶ x), k ∘ g = k' ∘ g → k = k') :
  Is_coequalizer :=
{ commutes := commutes,
  universal := λ x,
  { e :=
    { to_fun := coequalizer_comparison commutes x,
      inv_fun := λ p, induced p.val p.property,
      left_inv := assume h, by apply uniqueness; rw induced_commutes; refl,
      right_inv := assume p, subtype.eq (induced_commutes p.val p.property) },
    h := rfl } }

parameters (H : Is_coequalizer)
def Is_coequalizer.induced {x} (h : b ⟶ x) (e : h ∘ f₀ = h ∘ f₁) : c ⟶ x :=
(H.universal x).e.symm ⟨h, e⟩

@[simp] lemma Is_coequalizer.induced_commutes {x} (h : b ⟶ x) (e) :
  H.induced h e ∘ g = h :=
congr_arg subtype.val $ (H.universal x).cancel_right

lemma Is_coequalizer.uniqueness {x} {k k' : c ⟶ x} (e : k ∘ g = k' ∘ g) : k = k' :=
(H.universal x).bijective.1 (subtype.eq e)

end Is

-- A coequalizer of a given diagram.
structure coequalizer {a b : C} (f₀ f₁ : a ⟶ b) :=
(ob : C)
(map : b ⟶ ob)
(is_coequalizer : Is_coequalizer f₀ f₁ map)

parameters (C)
-- A choice of coequalizers of all diagrams.
class has_coequalizers :=
(coequalizer : Π ⦃a b : C⦄ (f₀ f₁ : a ⟶ b), coequalizer f₀ f₁)

end coequalizer

section pushout

section Is
-- The putative pushout diagram.
-- TODO: Order of indices? I sometimes prefer the "f g f' g' order",
-- where f' is the pushout of f and g' is the pushout of g; that's
-- "f₀ f₁ g₁ g₀" here.
parameters {a b₀ b₁ c : C} {f₀ : a ⟶ b₀} {f₁ : a ⟶ b₁} {g₀ : b₀ ⟶ c} {g₁ : b₁ ⟶ c}

-- The diagram above is a pushout diagram when giving a map c ⟶ x is
-- the same as giving a map b₀ ⟶ x and a map b₁ ⟶ x whose pullbacks to
-- a ⟶ x agree.
def pushout_comparison (commutes : g₀ ∘ f₀ = g₁ ∘ f₁) (x : C) :
  (c ⟶ x) → {p : (b₀ ⟶ x) × (b₁ ⟶ x) // p.1 ∘ f₀ = p.2 ∘ f₁} :=
λ k, ⟨(k ∘ g₀, k ∘ g₁), have _ := commutes, by rw [←assoc, ←assoc, this]⟩

parameters (f₀ f₁ g₀ g₁)
-- The (constructive) property of being a pushout.
structure Is_pushout : Type (max u v) :=
(universal : Π x,
  Bij_on (λ (k : c ⟶ x), (k ∘ g₀, k ∘ g₁)) set.univ {p | p.1 ∘ f₀ = p.2 ∘ f₁})

instance Is_pushout.subsingleton : subsingleton Is_pushout :=
⟨by intros p p'; cases p; cases p'; congr⟩

parameters {f₀ f₁ g₀ g₁}
-- Alternative verification of being a pushout.
def Is_pushout.mk'
  (commutes : g₀ ∘ f₀ = g₁ ∘ f₁)
  (induced : Π {x} (h₀ : b₀ ⟶ x) (h₁ : b₁ ⟶ x), h₀ ∘ f₀ = h₁ ∘ f₁ → (c ⟶ x))
  (induced_commutes₀ : ∀ {x} (h₀ : b₀ ⟶ x) (h₁ : b₁ ⟶ x) (e), induced h₀ h₁ e ∘ g₀ = h₀)
  (induced_commutes₁ : ∀ {x} (h₀ : b₀ ⟶ x) (h₁ : b₁ ⟶ x) (e), induced h₀ h₁ e ∘ g₁ = h₁)
  (uniqueness : ∀ {x} (k k' : c ⟶ x), k ∘ g₀ = k' ∘ g₀ → k ∘ g₁ = k' ∘ g₁ → k = k') :
  Is_pushout :=
{ universal := λ x,
  Bij_on.mk_univ
    { to_fun := pushout_comparison commutes x,
      inv_fun := λ p, induced p.val.1 p.val.2 p.property,
      left_inv := assume h, by
        apply uniqueness; rw induced_commutes₀ <|> rw induced_commutes₁; refl,
      right_inv := assume p, subtype.eq $ prod.ext
        (induced_commutes₀ p.val.1 p.val.2 p.property)
        (induced_commutes₁ p.val.1 p.val.2 p.property) }
    (assume p, rfl) }

parameters (H : Is_pushout)
include H

def Is_pushout.commutes : g₀ ∘ f₀ = g₁ ∘ f₁ :=
by convert (H.universal c).maps_to (_ : 𝟙 c ∈ set.univ); simp

def Is_pushout.induced {x} (h₀ : b₀ ⟶ x) (h₁ : b₁ ⟶ x) (e : h₀ ∘ f₀ = h₁ ∘ f₁) : c ⟶ x :=
(H.universal x).e.symm ⟨(h₀, h₁), e⟩

private lemma Is_pushout.induced_commutes' {x} (h₀ : b₀ ⟶ x) (h₁ : b₁ ⟶ x) (e) :
  (λ (k : c ⟶ x), (k ∘ g₀, k ∘ g₁)) (H.induced h₀ h₁ e) = (h₀, h₁) :=
(H.universal x).right_inv ⟨(h₀, h₁), e⟩

@[simp] lemma Is_pushout.induced_commutes₀ {x} (h₀ : b₀ ⟶ x) (h₁ : b₁ ⟶ x) (e) :
  H.induced h₀ h₁ e ∘ g₀ = h₀ :=
congr_arg prod.fst (Is_pushout.induced_commutes' h₀ h₁ e)

@[simp] lemma Is_pushout.induced_commutes₁ {x} (h₀ : b₀ ⟶ x) (h₁ : b₁ ⟶ x) (e) :
  H.induced h₀ h₁ e ∘ g₁ = h₁ :=
congr_arg prod.snd (Is_pushout.induced_commutes' h₀ h₁ e)

lemma Is_pushout.uniqueness {x} {k k' : c ⟶ x}
  (e₀ : k ∘ g₀ = k' ∘ g₀) (e₁ : k ∘ g₁ = k' ∘ g₁) : k = k' :=
(H.universal x).injective (prod.ext e₀ e₁)

end Is

-- A pushout of a given diagram.
structure pushout {a b₀ b₁ : C} (f₀ : a ⟶ b₀) (f₁ : a ⟶ b₁) :=
(ob : C)
(map₀ : b₀ ⟶ ob)
(map₁ : b₁ ⟶ ob)
(is_pushout : Is_pushout f₀ f₁ map₀ map₁)

parameters (C)
-- A choice of pushouts of all diagrams.
class has_pushouts :=
(pushout : Π ⦃a b₀ b₁ : C⦄ (f₀ : a ⟶ b₀) (f₁ : a ⟶ b₁), pushout f₀ f₁)

end pushout

end
end category_theory