import hacks_and_tricks.by_exactI_hack
import system_of_complexes.basic
import facts

universe variables v u
noncomputable theory
open opposite category_theory
open_locale nnreal

/-!

# Systems of double complexes of seminormed groups

In this file we define systems of double complexes of seminormed groups,
as needed for Definition 9.6 of [Analytic].

## Main declarations

* `system_of_double_complexes`: a system of complexes of seminormed groups.
* `admissible`: such a system is *admissible* if all maps that occur in the system
    are norm-nonincreasing.

-/

/-- A system of double complexes of seminormed groups, indexed by `ℝ≥0`.
See also Definition 9.3 of [Analytic]. -/
@[derive category_theory.category]
def system_of_double_complexes : Type (u+1) :=
ℝ≥0ᵒᵖ ⥤ (cochain_complex (cochain_complex SemiNormedGroup.{u} ℕ) ℕ)

namespace system_of_double_complexes

variables (C : system_of_double_complexes)

/-- `C.X c p q` is the object $C_c^{p,q}$ in a system of double complexes `C`. -/
def X (c : ℝ≥0) (p q : ℕ) : SemiNormedGroup :=
((C.obj $ op c).X p).X q

/-- `C.res` is the restriction map `C.X c' p q ⟶ C.X c p q` for a system of complexes `C`,
and nonnegative reals `c ≤ c'`. -/
def res {c' c : ℝ≥0} {p q : ℕ} [h : fact (c ≤ c')] :
  C.X c' p q ⟶ C.X c p q :=
((C.map (hom_of_le h.out).op).f p).f q

variables (c : ℝ≥0) {c₁ c₂ c₃ : ℝ≥0} (p p' q q' : ℕ)

@[simp] lemma res_refl : @res C c c p q _ = 𝟙 _ :=
begin
  have := (category_theory.functor.map_id C (op $ c)),
  delta res, erw this, refl
end

@[simp] lemma norm_res_of_eq (h : c₂ = c₁) (x : C.X c₁ p q) : ∥@res C _ _ p q ⟨h.le⟩ x∥ = ∥x∥ :=
by { cases h, rw res_refl, refl }

@[simp] lemma res_comp_res (h₁ : fact (c₂ ≤ c₁)) (h₂ : fact (c₃ ≤ c₂)) :
  @res C _ _ p q h₁ ≫ @res C _ _ p q h₂  = @res C _ _ p q ⟨h₂.out.trans h₁.out⟩ :=
begin
  have := (category_theory.functor.map_comp C (hom_of_le h₁.out).op (hom_of_le h₂.out).op),
  rw [← op_comp] at this,
  delta res, erw this, refl,
end

@[simp] lemma res_res (h₁ : fact (c₂ ≤ c₁)) (h₂ : fact (c₃ ≤ c₂)) (x : C.X c₁ p q) :
  @res C _ _ p q h₂ (@res C _ _ p q h₁ x) = @res C _ _ p q ⟨h₂.out.trans h₁.out⟩ x :=
by { rw ← (C.res_comp_res p q h₁ h₂), refl }

/-- `C.d` is the differential `C.X c p q ⟶ C.X c (p+1) q` for a system of double complexes `C`. -/
def d {c : ℝ≥0} (p p' : ℕ) {q : ℕ} : C.X c p q ⟶ C.X c p' q :=
((C.obj $ op c).d p p').f q

lemma d_eq_zero (c : ℝ≥0) (h : p + 1 ≠ p') : (C.d p p' : C.X c p q ⟶ _) = 0 :=
by { have : (C.obj (op c)).d p p' = 0 := (C.obj $ op c).shape _ _ h, rw [d, this], refl }

lemma d_eq_zero_apply (c : ℝ≥0) (h : p + 1 ≠ p') (x : C.X c p q) : (C.d p p' x) = 0 :=
by { rw [d_eq_zero C p p' q c h], refl }

@[simp] lemma d_self_apply (c : ℝ≥0) (x : C.X c p q) : (C.d p p x) = 0 :=
d_eq_zero_apply _ _ _ _ _ p.succ_ne_self _

lemma d_comp_res (h : fact (c₂ ≤ c₁)) :
  C.d p p' ≫ @res C _ _ _ q h = @res C _ _ p q _ ≫ C.d p p' :=
congr_fun (congr_arg homological_complex.hom.f ((C.map (hom_of_le h.out).op).comm p p')).symm q

lemma d_res (h : fact (c₂ ≤ c₁)) (x) :
  @d C c₂ p p' q (@res C _ _ p q _ x) = @res C _ _ _ _ h (@d C c₁ p p' q x) :=
show (@res C _ _ p q _ ≫ C.d p p') x = (C.d p p' ≫ @res C _ _ _ _ h) x,
by rw d_comp_res

@[simp] lemma d_comp_d {c : ℝ≥0} {p p' p'' q : ℕ} :
  @d C c p p' q ≫ C.d p' p'' = 0 :=
congr_fun (congr_arg homological_complex.hom.f ((C.obj $ op c).d_comp_d p p' p'')) q

@[simp] lemma d_d {c : ℝ≥0} {p p' p'' q : ℕ} (x : C.X c p q) :
  C.d p' p'' (C.d p p' x) = 0 :=
show (C.d _ _ ≫ C.d _ _) x = 0, by { rw d_comp_d, refl }

/-- `C.d'` is the differential `C.X c p q ⟶ C.X c p (q+1)` for a system of double complexes `C`. -/
def d' {c : ℝ≥0} {p : ℕ} (q q' : ℕ) : C.X c p q ⟶ C.X c p q' :=
((C.obj $ op c).X p).d q q'

lemma d'_eq_zero (c : ℝ≥0) (h : q + 1 ≠ q') : (C.d' q q' : C.X c p q ⟶ _) = 0 :=
((C.obj $ op c).X p).shape _ _ h

lemma d'_eq_zero_apply (c : ℝ≥0) (h : q + 1 ≠ q') (x : C.X c p q) : (C.d' q q' x) = 0 :=
by { rw [d'_eq_zero C p q q' c h], refl }

@[simp] lemma d'_self_apply (c : ℝ≥0) (x : C.X c p q) : (C.d' q q x) = 0 :=
d'_eq_zero_apply _ _ _ _ _ q.succ_ne_self _

lemma d'_comp_res (h : fact (c₂ ≤ c₁)) :
  @d' C c₁ p q q' ≫ @res C _ _ _ _ h = @res C _ _ p q _ ≫ @d' C c₂ p q q' :=
(((C.map (hom_of_le h.out).op).f p).comm q q').symm

lemma d'_res (h : fact (c₂ ≤ c₁)) (x) :
  C.d' q q' (@res C _ _ p q _ x) = @res C _ _ _ _ h (C.d' q q' x) :=
show (@res C _ _ p q _ ≫ C.d' q q') x = (C.d' q q' ≫ @res C _ _ _ _ h) x,
by rw d'_comp_res

@[simp] lemma d'_comp_d' {c : ℝ≥0} {p q q' q'' : ℕ} :
  @d' C c p q q' ≫ C.d' q' q'' = 0 :=
((C.obj $ op c).X p).d_comp_d q q' q''

@[simp] lemma d'_d' {c : ℝ≥0} {p q q' q'' : ℕ} (x : C.X c p q) :
  C.d' q' q'' (C.d' q q' x) = 0 :=
show (C.d' _ _ ≫ C.d' _ _) x = 0, by { rw d'_comp_d', refl }

lemma d'_comp_d (c : ℝ≥0) (p p' q q' : ℕ) :
  C.d' q q' ≫ C.d p p' = C.d p p' ≫ (C.d' q q' : C.X c p' q ⟶ _) :=
(((C.obj $ op c).d p p').comm q q').symm

lemma d'_d (c : ℝ≥0) (p p' q q' : ℕ) (x : C.X c p q) :
  C.d' q q' (C.d p p' x) = C.d p p' (C.d' q q' x) :=
show (C.d p p' ≫ C.d' q q') x = (C.d' q q' ≫ C.d p p') x,
by rw [d'_comp_d]

/-- Convenience definition:
The identity morphism of an object in the system of double complexes
when it is given by different indices that are not
definitionally equal. -/
def congr {c c' : ℝ≥0} {p p' q q' : ℕ} (hc : c = c') (hp : p = p') (hq : q = q') :
  C.X c p q ⟶ C.X c' p' q' :=
eq_to_hom $ by { subst hc, subst hp, subst hq, }

/-- The `p`-th row in a system of double complexes, as system of complexes.
  It has object `(C.obj c).X p`over `c`. -/
def row (C : system_of_double_complexes.{u}) (p : ℕ) : system_of_complexes.{u} :=
C ⋙ homological_complex.forget _ _ ⋙ pi.eval _ p

@[simp] lemma row_X (C : system_of_double_complexes) (p q : ℕ) (c : ℝ≥0) :
  C.row p c q = C.X c p q :=
rfl

@[simp] lemma row_res (C : system_of_double_complexes) (p q : ℕ) {c' c : ℝ≥0} [h : fact (c ≤ c')] :
  @system_of_complexes.res (C.row p) _ _ q h  = @res C _ _ p q h :=
rfl

@[simp] lemma row_d (C : system_of_double_complexes) (c : ℝ≥0) (p : ℕ) :
  (C.row p).d = @d' C c p :=
rfl

/-- The differential between rows in a system of double complexes,
as map of system of complexes. -/
@[simps app_f]
def row_map (C : system_of_double_complexes.{u}) (p p' : ℕ) :
  C.row p ⟶ C.row p' :=
{ app := λ c,
  { f := λ q, (C.d p p' : C.X c.unop p q ⟶ C.X c.unop p' q),
    comm' := λ q q' _, (C.d'_comp_d _ p p' q q').symm },
  naturality' := λ c₁ c₂ h, (C.map h).comm p p' }

@[simp] lemma row_map_apply (C : system_of_double_complexes.{u})
  (c : ℝ≥0) (p p' q : ℕ) (x : C.X c p q) :
  C.row_map p p' x = C.d p p' x := rfl

-- -- this should be found by TC, but we first need to make `pi.eval` and `graded_object` additive
-- instance aux : (homological_complex.forget SemiNormedGroup (complex_shape.up ℕ) ⋙
--   pi.eval (λ (_ : ℕ), SemiNormedGroup) q).additive :=
-- { map_zero' := λ C₁ C₂, by { dsimp, refl },
--   map_add' := by { intros, dsimp, refl } }

/-- The `q`-th column in a system of double complexes, as system of complexes. -/
@[simps]
def col (C : system_of_double_complexes.{u}) (q : ℕ) : system_of_complexes.{u} :=
C ⋙ functor.map_homological_complex (homological_complex.eval _ _ q) _

@[simp] lemma col_X (C : system_of_double_complexes) (p q : ℕ) (c : ℝ≥0) :
  C.col q c p = C.X c p q :=
rfl

@[simp] lemma col_res (C : system_of_double_complexes) (p q : ℕ) {c' c : ℝ≥0} [h : fact (c ≤ c')] :
  (@system_of_complexes.res (C.col q) _ _ p h : C.col q c' p ⟶ C.col q c p) =
  -- (@res C _ _ p q h : C.X c' p q ⟶ C.X c p q) :=
  by dsimp_result { dsimp, exact (@res C _ _ p q h : C.X c' p q ⟶ C.X c p q) } :=
rfl

@[simp] lemma col_d (C : system_of_double_complexes) (c : ℝ≥0) (p p' q : ℕ) :
  @system_of_complexes.d (C.col q) c p p' =
  by dsimp_result { dsimp, exact @d C c p p' q } :=
rfl

/-- The differential between columns in a system of double complexes,
as map of system of complexes. -/
def col_map (C : system_of_double_complexes.{u}) (q q' : ℕ) :
  C.col q ⟶ C.col q' :=
{ app := λ c,
  { f := λ p, (C.d' q q' : C.X c.unop p q ⟶ C.X c.unop p q'),
    comm' := λ p p' _, (C.d'_comp_d _ p p' q q') },
  naturality' := λ c₁ c₂ h, by { ext p : 2, exact ((C.map h).f p).comm q q' } }

/-- A system of double complexes is *admissible*
if all the differentials and restriction maps are norm-nonincreasing.

See Definition 9.3 of [Analytic]. -/
structure admissible (C : system_of_double_complexes) : Prop :=
(d_norm_noninc' : ∀ c p p' q (h : p + 1 = p'), (@d C c p p' q).norm_noninc)
(d'_norm_noninc' : ∀ c p q q' (h : q + 1 = q'), (@d' C c p q q').norm_noninc)
(res_norm_noninc : ∀ c' c p q h, (@res C c' c p q h).norm_noninc)

namespace admissible

variables {C}

lemma d_norm_noninc (hC : C.admissible) (c : ℝ≥0) (p p' q : ℕ) :
  (C.d p p' : C.X c p q ⟶ _).norm_noninc :=
begin
  by_cases h : p + 1 = p',
  { exact hC.d_norm_noninc' c p p' q h },
  { rw C.d_eq_zero p p' q c h, intro v, simp }
end

lemma d'_norm_noninc (hC : C.admissible) (c : ℝ≥0) (p q q' : ℕ) :
  (C.d' q q' : C.X c p q ⟶ _).norm_noninc :=
begin
  by_cases h : q + 1 = q',
  { exact hC.d'_norm_noninc' c p q q' h },
  { rw C.d'_eq_zero p q q' c h, intro v, simp }
end

lemma col (hC : C.admissible) (q : ℕ) : (C.col q).admissible :=
{ d_norm_noninc' := λ c i j h, hC.d_norm_noninc _ _ _ _,
  res_norm_noninc := λ c i j h, hC.res_norm_noninc _ _ _ _ _ }

lemma row (hC : C.admissible) (p : ℕ) : (C.row p).admissible :=
{ d_norm_noninc' := λ c i j h, hC.d'_norm_noninc _ _ _ _,
  res_norm_noninc := λ c i j h, hC.res_norm_noninc _ _ _ _ _ }

lemma mk' (h : ∀ p, (C.row p).admissible)
  (hd : ∀ c p p' q (h : p + 1 = p'), (@d C c p p' q).norm_noninc) :
  C.admissible :=
{ d_norm_noninc' := λ c p p' q h', hd c p p' q h',
  d'_norm_noninc' := λ c p q q' h', (h p).d_norm_noninc' _ _ _ h',
  res_norm_noninc := λ c₁ c₂ p q h', by { resetI, apply (h p).res_norm_noninc } }

end admissible

end system_of_double_complexes


lemma contrapositive2 (P Q : Prop) : (¬ Q → ¬ P) → (P → Q) :=
begin

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.algebraic_geometry.Spec
import Mathlib.PostPort

universes u_1 l

namespace Mathlib

/-!
# The category of schemes

A scheme is a locally ringed space such that every point is contained in some open set
where there is an isomorphism of presheaves between the restriction to that open set,
and the structure sheaf of `Spec R`, for some commutative ring `R`.

A morphism is schemes is just a morphism of the underlying locally ringed spaces.

-/

namespace algebraic_geometry

/--
We define `Scheme` as a `X : LocallyRingedSpace`,
along with a proof that every point has an open neighbourhood `U`
so that that the restriction of `X` to `U` is isomorphic, as a space with a presheaf of commutative
rings, to `Spec.PresheafedSpace R` for some `R : CommRing`.

(Note we're not asking in the definition that this is an isomorphism as locally ringed spaces,
although that is a consequence.)
-/
structure Scheme where
  local_affine :
    ∀
      (x :
        ↥(PresheafedSpace.carrier
            (SheafedSpace.to_PresheafedSpace (LocallyRingedSpace.to_SheafedSpace _X)))),
      ∃ (U :
        topological_space.opens
          ↥(PresheafedSpace.carrier
              (SheafedSpace.to_PresheafedSpace (LocallyRingedSpace.to_SheafedSpace _X)))),
        ∃ (m : x ∈ U),
          ∃ (R : CommRing),
            ∃ (i :
              PresheafedSpace.restrict
                  (SheafedSpace.to_PresheafedSpace (LocallyRingedSpace.to_SheafedSpace _X))
                  (topological_space.opens.inclusion U)
                  (topological_space.opens.inclusion_open_embedding U) ≅
                Spec.PresheafedSpace R),
              True

-- PROJECT

-- In fact, we can make the isomorphism `i` above an isomorphism in `LocallyRingedSpace`.

-- However this is a consequence of the above definition, and not necessary for defining schemes.

-- We haven't done this yet because we haven't shown that you can restrict a `LocallyRingedSpace`

-- along an open embedding.

-- We can do this already for `SheafedSpace` (as above), but we need to know that

-- the stalks of the restriction are still local rings, which we follow if we knew that

-- the stalks didn't change.

-- This will follow if we define cofinal functors, and show precomposing with a cofinal functor

-- doesn't change colimits, because open neighbourhoods of `x` within `U` are cofinal in

-- all open neighbourhoods of `x`.

namespace Scheme

/--
Every `Scheme` is a `LocallyRingedSpace`.
-/
-- (This parent projection is apparently not automatically generated because

-- we used the `extends X : LocallyRingedSpace` syntax.)

def to_LocallyRingedSpace (S : Scheme) : LocallyRingedSpace :=
  LocallyRingedSpace.mk (LocallyRingedSpace.to_SheafedSpace (X S)) sorry

/--
`Spec R` as a `Scheme`.
-/
def Spec (R : CommRing) : Scheme :=
  mk (LocallyRingedSpace.mk (LocallyRingedSpace.to_SheafedSpace (Spec.LocallyRingedSpace R)) sorry)
    sorry

/--
The empty scheme, as `Spec 0`.
-/
def empty : Scheme := Spec (CommRing.of PUnit)

protected instance has_emptyc : has_emptyc Scheme := has_emptyc.mk empty

protected instance inhabited : Inhabited Scheme := { default := ∅ }

/--
Schemes are a full subcategory of locally ringed spaces.
-/
protected instance category_theory.category : category_theory.category Scheme :=
  category_theory.induced_category.category to_LocallyRingedSpace

/--
The global sections, notated Gamma.
-/
def Γ : Schemeᵒᵖ ⥤ CommRing :=
  category_theory.functor.op (category_theory.induced_functor to_LocallyRingedSpace) ⋙
    LocallyRingedSpace.Γ

theorem Γ_def :
    Γ =
        category_theory.functor.op (category_theory.induced_functor to_LocallyRingedSpace) ⋙
          LocallyRingedSpace.Γ :=
  rfl

@[simp] theorem Γ_obj (X : Schemeᵒᵖ) :
    category_theory.functor.obj Γ X =
        category_theory.functor.obj
          (PresheafedSpace.presheaf
            (SheafedSpace.to_PresheafedSpace
              (LocallyRingedSpace.to_SheafedSpace (X (opposite.unop X)))))
          (opposite.op ⊤) :=
  rfl

theorem Γ_obj_op (X : Scheme) :
    category_theory.functor.obj Γ (opposite.op X) =
        category_theory.functor.obj
          (PresheafedSpace.presheaf
            (SheafedSpace.to_PresheafedSpace (LocallyRingedSpace.to_SheafedSpace (X X))))
          (opposite.op ⊤) :=
  rfl

@[simp] theorem Γ_map {X : Schemeᵒᵖ} {Y : Schemeᵒᵖ} (f : X ⟶ Y) :
    category_theory.functor.map Γ f =
        category_theory.nat_trans.app
            (PresheafedSpace.hom.c (subtype.val (category_theory.has_hom.hom.unop f)))
            (opposite.op ⊤) ≫
          category_theory.functor.map
            (PresheafedSpace.presheaf
              (SheafedSpace.to_PresheafedSpace
                (LocallyRingedSpace.to_SheafedSpace (X (opposite.unop Y)))))
            (category_theory.has_hom.hom.op
              (topological_space.opens.le_map_top
                (PresheafedSpace.hom.base (subtype.val (category_theory.has_hom.hom.unop f))) ⊤)) :=
  rfl

theorem Γ_map_op {X : Scheme} {Y : Scheme} (f : X ⟶ Y) :
    category_theory.functor.map Γ (category_theory.has_hom.hom.op f) =
        category_theory.nat_trans.app (PresheafedSpace.hom.c (subtype.val f)) (opposite.op ⊤) ≫
          category_theory.functor.map
            (PresheafedSpace.presheaf
              (SheafedSpace.to_PresheafedSpace (LocallyRingedSpace.to_SheafedSpace (X X))))
            (category_theory.has_hom.hom.op
              (topological_space.opens.le_map_top (PresheafedSpace.hom.base (subtype.val f)) ⊤)) :=
  rfl

end Mathlib


import .algebra
noncomputable theory

set_option eqn_compiler.zeta true

universes u v w u₁ v₁ w₁

infix ` ⊗ `:100 := tensor_product

variables {R : Type u} {A : Type v} {B : Type w} {C : Type u₁} {D : Type v₁}
variables [comm_ring R] [comm_ring A] [comm_ring B] [comm_ring C] [comm_ring D]
variables (iA : algebra R A) (iB : algebra R B) (iC : algebra R C) (iD : algebra R D)

namespace tensor_product
open linear_map

set_option class.instance_max_depth 200
def lmul : iA.mod ⊗ iB.mod →ₗ iA.mod ⊗ iB.mod →ₗ iA.mod ⊗ iB.mod :=
lift $ linear_map.compr₂
  ((linear_map.lflip _ _ _ _).comp $
    linear_map.compr₂
      (curry $ curry $ map (lift iA.lmul) $
        lift iB.lmul)
      (lcurry _ _ _))
  (uncurry _ _ _)

theorem lmul_tmul (p : iA.mod) (q : iB.mod) (r : iA.mod) (s : iB.mod) :
  lmul iA iB (p ⊗ₜ q) (r ⊗ₜ s) = (p * r) ⊗ₜ (q * s) :=
by rw [lmul, lift.tmul, compr₂_apply, uncurry_apply, comp_apply, lflip_apply, compr₂_apply, lcurry_apply,
    curry_apply, curry_apply, map_tmul, lift.tmul, lift.tmul]; refl

instance : comm_ring (iA.mod ⊗ iB.mod) :=
{ mul := λ x y, lmul iA iB x y,
  mul_assoc := begin
    intros x y z,
    show lmul iA iB (lmul iA iB x y) z =
      lmul iA iB x (lmul iA iB y z),
    refine tensor_product.induction_on _ _ z _ (λ z₁ z₂, _) (λ z₁ z₂ ih₁ ih₂, _),
    { simp only [map_zero] },
    { refine tensor_product.induction_on _ _ y _ (λ y₁ y₂, _) (λ y₁ y₂ ih₁ ih₂, _),
      { rw [map_zero₂, map_zero, map_zero₂] },
      { refine tensor_product.induction_on _ _ x _ (λ x₁ x₂, _) (λ x₁ x₂ ih₁ ih₂, _),
        { rw [map_zero₂, map_zero₂, map_zero₂] },
        { iterate 4 { rw [lmul_tmul] },
          iterate 2 { rw mul_assoc } },
        { rw [map_add₂, map_add₂, map_add₂], congr' 1, exacts [ih₁, ih₂] } },
      { rw [map_add₂, map_add, map_add₂, map_add], congr' 1, exacts [ih₁, ih₂] } },
    { rw [map_add, map_add, map_add], congr' 1, exacts [ih₁, ih₂] }
  end,
  one := 1 ⊗ₜ 1,
  one_mul := λ x, show lmul iA iB (1 ⊗ₜ 1) x = x, from
    tensor_product.induction_on _ _ x (map_zero _)
    (λ x y, (lmul_tmul _ _ _ _ _ _).trans $ by rw [one_mul, one_mul])
    (λ x y ihx ihy, (map_add _ _ _).trans $ by rw [ihx, ihy]),
  mul_one := λ x, show lmul iA iB x (1 ⊗ₜ 1) = x, from
    tensor_product.induction_on _ _ x (map_zero₂ _ _)
    (λ x y, (lmul_tmul _ _ _ _ _ _).trans $ by rw [mul_one, mul_one])
    (λ x y ihx ihy, (map_add₂ _ _ _ _).trans $ by rw [ihx, ihy]),
  left_distrib := λ _, map_add _,
  right_distrib := map_add₂ _,
  mul_comm := λ x y, show lmul iA iB x y = lmul iA iB y x, from
    tensor_product.induction_on _ _ x (by rw [map_zero₂, map_zero])
      (λ x₁ x₂, tensor_product.induction_on _ _ y (by rw [map_zero₂, map_zero])
        (λ y₁ y₂, by rw [lmul_tmul, lmul_tmul, mul_comm x₁ y₁, mul_comm x₂ y₂])
        (λ y₁ y₂ ih₁ ih₂, by rw [map_add₂, map_add, ih₁, ih₂]))
      (λ x₁ x₂ ih₁ ih₂, by rw [map_add₂, map_add, ih₁, ih₂]),
  .. tensor_product.add_comm_group _ _ }

set_option class.instance_max_depth 32

theorem mul_def (p : iA.mod) (q : iB.mod) (r : iA.mod) (s : iB.mod) :
  (p ⊗ₜ q) * (r ⊗ₜ s) = (p * r) ⊗ₜ (q * s) :=
lmul_tmul _ _ _ _ _ _

theorem one_def : (1 : iA.mod ⊗ iB.mod) = 1 ⊗ₜ 1 := rfl

end tensor_product

namespace algebra
open tensor_product linear_map

def tensor_product : algebra R (iA.mod ⊗ iB.mod) :=
{ to_fun := λ r, iA r ⊗ₜ 1,
  hom := ⟨by rw iA.map_one; refl,
    λ x y, by rw [iA.map_mul, mul_def, mul_one],
    λ x y, by rw [iA.map_add, add_tmul]⟩,
  smul_def' := λ r x, tensor_product.induction_on _ _ x
    (by rw [smul_zero, mul_zero])
    (λ x y, by rw [← tmul_smul, ← smul_tmul, mul_def, iA.smul_def, one_mul])
    (λ x y ihx ihy, by rw [smul_add, mul_add, ihx, ihy]) }

def inl : iA →ₐ iA.tensor_product iB :=
{ to_fun := λ x, x ⊗ₜ 1,
  hom := ⟨rfl, λ x y, by rw [mul_def, mul_one], λ x y, add_tmul _ _ _⟩,
  commutes' := λ r, rfl }

theorem inl_def (p : iA.mod) : iA.inl iB p = p ⊗ₜ 1 := rfl

def inr : iB →ₐ iA.tensor_product iB :=
{ to_fun := λ x, 1 ⊗ₜ x,
  hom := ⟨rfl, λ x y, by rw [mul_def, mul_one], λ x y, tmul_add _ _ _⟩,
  commutes' := λ r, by rw [← mul_one (iB r), ← iB.smul_def, ← smul_tmul, iA.smul_def, mul_one]; refl }

theorem inr_def (q : iB.mod) : iA.inr iB q = 1 ⊗ₜ q := rfl

namespace tensor_product

variables {iA iB iC}
set_option class.instance_max_depth 100
@[elab_with_expected_type]
def arec (f : iA →ₐ iC) (g : iB →ₐ iC) : iA.tensor_product iB →ₐ iC :=
{ to_fun := (tensor_product.lift iC.lmul).comp $ map f.to_linear_map g.to_linear_map,
  hom := ⟨by rw [one_def, comp_apply, map_tmul, lift.tmul]; show f 1 * g 1 = 1;
      rw [f.map_one, g.map_one, mul_one],
    λ x y, tensor_product.induction_on _ _ x
      (by rw [zero_mul, linear_map.map_zero]; exact (zero_mul _).symm)
      (λ x₁ x₂, tensor_product.induction_on _ _ y
        (by rw [mul_zero, linear_map.map_zero]; exact (mul_zero _).symm)
        (λ y₁ y₂, by simp only [mul_def, comp_apply, map_tmul, lift.tmul];
          change f _ * g _ = (f _ * g _) * (f _ * g _);
          rw [f.map_mul, g.map_mul, mul_assoc, mul_assoc, mul_left_comm (f y₁)])
        (λ y₁ y₂ ih₁ ih₂, by simp only [mul_add, linear_map.map_add, ih₁, ih₂]))
      (λ x₁ x₂ ih₁ ih₂, by simp only [add_mul, linear_map.map_add, ih₁, ih₂]),
    linear_map.map_add _⟩,
  commutes' := λ r, show lift iC.lmul (map f.to_linear_map g.to_linear_map (iA r ⊗ₜ 1)) = _,
    by rw [map_tmul, lift.tmul]; change f _ * g 1 = _; rw [f.commutes, g.map_one, mul_one] }
set_option class.instance_max_depth 32

theorem arec_tmul (f : iA →ₐ iC) (g : iB →ₐ iC) (p : iA.mod) (q : iB.mod) :
  arec f g (p ⊗ₜ q) = f p * g q :=
lift.tmul _ _

variables (iA iB iC)
def UMP : ((iA →ₐ iC) × (iB →ₐ iC)) ≃ (iA.tensor_product iB →ₐ iC) :=
{ to_fun := λ φ, arec φ.1 φ.2,
  inv_fun := λ φ, (φ.comp (iA.inl iB), φ.comp (iA.inr iB)),
  left_inv := λ ⟨φ₁, φ₂⟩, prod.ext
    (by ext p; change (arec φ₁ φ₂) (p ⊗ₜ 1) = φ₁ p;
      rw [arec_tmul, φ₂.map_one', mul_one])
    (by ext q; change (arec φ₁ φ₂) (1 ⊗ₜ q) = φ₂ q;
      rw [arec_tmul, φ₁.map_one', one_mul]),
  right_inv := λ φ, alg_hom.to_linear_map_inj $ tensor_product.ext $ λ p q,
    by dsimp only [alg_hom.to_linear_map_apply]; rw [arec_tmul,
      alg_hom.comp_apply, alg_hom.comp_apply, inl_def, inr_def, ← φ.map_mul, mul_def, mul_one, one_mul] }

variables {iA iB iC iD}
def amap (f : iA →ₐ iC) (g : iB →ₐ iD) : (iA.tensor_product iB) →ₐ (iC.tensor_product iD) :=
arec ((iC.inl iD).comp f) ((iC.inr iD).comp g)
variables (iA iB iC iD)

@[simp] lemma amap_tmul (f : iA →ₐ iC) (g : iB →ₐ iD) (x : A) (y : B) :
  amap f g (x ⊗ₜ y) = f x ⊗ₜ g y :=
by rw amap; simp only [arec_tmul,
  alg_hom.comp_apply, inl_def, inr_def, mul_def, mul_one, one_mul]

def aassoc : (iA.tensor_product iB).tensor_product iC →ₐ
  iA.tensor_product (iB.tensor_product iC) :=
arec (arec
  (iA.inl $ iB.tensor_product iC)
  ((iA.inr $ iB.tensor_product iC).comp $ iB.inl iC))
  ((iA.inr $ iB.tensor_product iC).comp $ iB.inr iC)

@[simp] lemma aassoc_tmul (x y z) :
  aassoc iA iB iC (x ⊗ₜ y ⊗ₜ z) = x ⊗ₜ (y ⊗ₜ z) :=
by rw aassoc; simp only [arec_tmul, inl_def, inr_def, alg_hom.comp_apply, mul_def, mul_one, one_mul]

def id_tensor : (algebra.id R).tensor_product iA →ₐ iA :=
arec iA.of_id (alg_hom.id iA)

@[simp] lemma id_tensor_tmul (r x) : id_tensor iA (r ⊗ₜ x) = ((r : R) • x : iA.mod) :=
by rw id_tensor; simp only [arec_tmul, alg_hom.id_apply, of_id_apply, iA.smul_def]

def tensor_id : iA.tensor_product (algebra.id R) →ₐ iA :=
arec (alg_hom.id iA) iA.of_id

@[simp] lemma tensor_id_tmul (r x) : tensor_id iA (x ⊗ₜ r) = ((r : R) • x : iA.mod) :=
by rw tensor_id; simp only [arec_tmul, alg_hom.id_apply, of_id_apply, iA.smul_def, mul_comm]

def base_change_left : algebra iA.mod (iA.mod ⊗ iB.mod) :=
algebra.of_core { to_fun := iA.inl iB }

theorem base_change_left_apply (r : iA.mod) : base_change_left iA iB r = r ⊗ₜ 1 := rfl

set_option class.instance_max_depth 100
def base_change_left_rec {D : Type v₁} [comm_ring D] (iD : algebra iA.mod D)
  (φ : iB →ₐ iA.comap iD) : base_change_left iA iB →ₐ iD :=
{ to_fun := (tensor_product.lift (iA.comap iD).lmul).comp
    (map (iA.to_comap iD).to_linear_map φ.to_linear_map),
  hom := ⟨by simp only [comp_apply, one_def, map_tmul, alg_hom.to_linear_map_apply, lmul_apply,
      lift.tmul, φ.map_one', (to_comap iA iD).map_one']; apply mul_one,
    λ x y, tensor_product.induction_on _ _ x
      (by rw [zero_mul, linear_map.map_zero]; exact (zero_mul _).symm)
      (λ x₁ x₂, tensor_product.induction_on _ _ y
        (by rw [mul_zero, linear_map.map_zero]; exact (mul_zero _).symm)
        (λ y₁ y₂, by simp only [mul_def, comp_apply, map_tmul, alg_hom.to_linear_map_apply, lmul_apply,
          lift.tmul, (iA.to_comap iD).map_mul, φ.map_mul, mul_assoc]; rw mul_left_comm ((iA.to_comap iD) y₁))
        (λ y₁ y₂ ih₁ ih₂, by rw [mul_add, linear_map.map_add, ih₁, ih₂, linear_map.map_add, mul_add]))
      (λ x₁ x₂ ih₁ ih₂, by rw [add_mul, linear_map.map_add, ih₁, ih₂, linear_map.map_add, add_mul]),
    linear_map.map_add _⟩,
  commutes' := λ x, by rw [comp_apply, base_change_left_apply, map_tmul, alg_hom.to_linear_map_apply,
    alg_hom.to_linear_map_apply, to_comap_apply, lift.tmul, lmul_apply, φ.map_one']; exact mul_one _ }
set_option class.instance_max_depth 32

def base_change_right : algebra B (iA.mod ⊗ iB.mod) :=
algebra.of_core { to_fun := iA.inr iB }

end tensor_product
end algebra


import order_mv_polynomial noetherian ideal

open mv_polynomial
open finsupp

namespace buch
variables {σ : Type*} {α : Type*} [decidable_eq σ] [decidable_eq α] [discrete_field α] [fintype σ]
variables [decidable_linear_order (σ →₀ ℕ)] [is_well_founded (σ →₀ ℕ) (<)] [is_monomial_order (σ →₀ ℕ) (≤)]

section reduction

def reduction (a b : mv_polynomial σ α) :=
    a - b * (monomial (a.LM - b.LM) (a.LC / b.LC))

def red_list_aux : mv_polynomial σ α → list (mv_polynomial σ α) → mv_polynomial σ α
| a [] := a
| a (hd :: tl) := if h : hd.LM ∣ a.LM  then red_list_aux (reduction a hd) tl else red_list_aux a tl

lemma reduction_of_LM_eqz {p q : mv_polynomial σ α} (hp : p.LM = 0) (hq : q.LM = 0) (hq' : q ≠ 0) : reduction p q = 0 :=
begin
    rw [reduction, eqC_of_LM_eqz.1 hp, eqC_of_LM_eqz.1 hq],
    simp [C, monomial_mul_monomial, mul_div_cancel' _ (LC_nez_iff.1 hq')],
end

lemma zero_red_list_aux : ∀ (l : list (mv_polynomial σ α)), red_list_aux 0 l = 0
| [] := by simp [red_list_aux]
| (q :: l') := begin
    by_cases q.LM ∣ (0 : mv_polynomial (σ) α).LM;
    simp [red_list_aux, h, reduction];
    exact zero_red_list_aux l',
end

theorem reduction_LM_lt {a b : mv_polynomial σ α} (hba : b.LM ∣ a.LM) (ha : a.LM ≠ 0) (hb : b ≠ 0) : (reduction a b).LM < a.LM := begin
    simp [reduction],
    apply sub_LM_lt _ ha,
    rw [LT_of_mul_m, LT_mul_monomial, add_sub_cancel' hba, mul_div_cancel' _ (LC_nez_iff.1 hb), LT],
end

lemma red_list_aux_red_LM_lt : ∀ (l : list (mv_polynomial σ α)) {p q : mv_polynomial σ α} (hqp : q.LM ∣ p.LM) (hp : p.LM ≠ 0) (hq : q ≠ 0),
(red_list_aux (reduction p q) l).LM < p.LM
| [] := by simp [red_list_aux]; apply reduction_LM_lt
| (r :: l') :=
λ p q hqp hp hq, begin
    by_cases h_dvd : r.LM ∣ (reduction p q).LM;
    simp [red_list_aux, h_dvd],
    {
        by_cases hr : r = 0,
        {simp [reduction, hr], apply red_list_aux_red_LM_lt, assumption'},
        by_cases h_r : (reduction p q).LM = 0,
        simp [h_r] at h_dvd,
        {
            rw [reduction_of_LM_eqz h_r h_dvd hr, zero_red_list_aux],
            simpa [finsupp.zero_lt_iff_ne_zero] using hp,
        },
        {apply lt_trans (red_list_aux_red_LM_lt l' h_dvd h_r hr) (reduction_LM_lt hqp hp hq)},
    },
    {apply red_list_aux_red_LM_lt; assumption},
end

theorem red_list_aux_LM_lt : ∀ (l : list (mv_polynomial σ α)) (p : mv_polynomial σ α) (hp : p.LM ≠ 0)
(h_red : red_list_aux p l ≠ p), (red_list_aux p l).LM < p.LM
| [] := by simp [red_list_aux]
| (r :: l') := λ p hp h_red, begin
    by_cases hr : r = 0,
    {simp [red_list_aux, reduction, hr] at h_red ⊢, apply red_list_aux_LM_lt, assumption'},
    by_cases hrp : r.LM ∣ p.LM;
    simp [red_list_aux, hrp] at h_red ⊢,
    apply red_list_aux_red_LM_lt l' hrp hp hr,
    apply red_list_aux_LM_lt, assumption',
end

def red_list : mv_polynomial σ α → list (mv_polynomial σ α) → mv_polynomial σ α
| a l :=
    let r := red_list_aux a l in
    if h₁ : r = a
    then r
    else if h₂ : a.LM = 0
        then 0
        else have r.LM < a.LM := red_list_aux_LM_lt _ _ h₂ h₁,
            red_list r l
using_well_founded
{ rel_tac := λ _ _, `[exact ⟨_, inv_image.wf (λ a, a.1.LM) _inst_6.wf⟩]
, dec_tac := tactic.assumption }

lemma zero_red_list : ∀ (l : list (mv_polynomial σ α)), red_list 0 l = 0
| [] := by unfold red_list; simp [red_list_aux]
| (hd :: tl) := begin
    unfold red_list, simp [zero_red_list_aux],
end

lemma eqz_of_red_list_aux_eq : ∀ (l : list (mv_polynomial σ α)) (p : mv_polynomial σ α),
(red_list_aux p l = p) → (∃ (q : mv_polynomial σ α) (hq₁ : q ∈ l) (hq₂ : q ≠ 0), q.LM = 0) → p = 0
| [] := by simp
| (r :: l') := λ p, begin
    simp_intros hp₁ hl [red_list_aux, -finset.insert_empty_eq_singleton],
    rcases hl with ⟨q, ⟨hq | hq, hq'₁, hq'₂⟩⟩,
    {
        rw hq at hq'₁ hq'₂,
        simp [hq'₂] at hp₁,
        by_cases hp₂ : p.LM = 0,
        {rwa [reduction_of_LM_eqz hp₂ hq'₂ hq'₁, zero_red_list_aux, eq_comm] at hp₁},
        {
            have h := red_list_aux_red_LM_lt l' (by simp [hq'₂]) hp₂ hq'₁,
            rw hp₁ at h,
            apply absurd h (lt_irrefl _),
        },
    },
    by_cases hrp : r.LM ∣ p.LM;
    simp [hrp] at hp₁,
    {
        by_cases hr : r = 0,
        {exact eqz_of_red_list_aux_eq l' _ (by simpa [hr, reduction] using hp₁) ⟨q, hq, hq'₁, hq'₂⟩},
        {

            by_cases hp₂ : p.LM = 0,
            {
                simp [hp₂] at hrp,
                rwa [reduction_of_LM_eqz hp₂ hrp hr, zero_red_list_aux, eq_comm] at hp₁,
            },
            {
                have h := red_list_aux_red_LM_lt l' hrp hp₂ hr,
                rw hp₁ at h,
                apply absurd h (lt_irrefl _),
            },
        },
    },
    {apply eqz_of_red_list_aux_eq l' _ hp₁, refine ⟨q, hq, hq'₁, hq'₂⟩},
end

lemma red_list_eqz_of_const : ∀ (p : mv_polynomial σ α) (l : list (mv_polynomial σ α)),
(∃ (q : mv_polynomial σ α) (hq₁ : q ∈ l) (hq₂ : q ≠ 0), q.LM = 0) → red_list p l = 0
| p l := λ h, begin
    unfold red_list,
    by_cases hp₁ : red_list_aux p l = p;
    by_cases hp₂ : p.LM = 0;
    simp [hp₁, hp₂],
    repeat {apply eqz_of_red_list_aux_eq l _ hp₁ h},
    {
        let : (red_list_aux p l).LM < p.LM, from red_list_aux_LM_lt l p hp₂ hp₁,
        apply red_list_eqz_of_const, assumption,
    }
end
using_well_founded
{ rel_tac := λ _ _, `[exact ⟨_, inv_image.wf (λ a, a.1.LM) _inst_6.wf⟩]
, dec_tac := tactic.assumption }

lemma red_list_nez_no_const : ∀ (l : list (mv_polynomial σ α)) (p : mv_polynomial σ α) (h : red_list p l ≠ 0)
(q : mv_polynomial σ α) (hq₁ : q ∈ l) (hq₂ : q ≠ 0), q.LM ≠ 0 :=
λ l p h q hq₁ hq₂ hq₃, h (red_list_eqz_of_const _ _ ⟨q, hq₁, hq₂, hq₃⟩)

lemma red_list_aux_not_div : ∀ (l : list (mv_polynomial σ α)) (p : mv_polynomial σ α) (h : red_list_aux p l = p)
    (q : mv_polynomial σ α) (hq₁ : q ∈ l) (hq₂ : q.LM ≠ 0), q.LM ∤ p.LM
| [] := by simp
| (r :: l') := begin
    simp_intros p hp₁ q hq₁ hq₂ [red_list_aux, -finset.insert_empty_eq_singleton], cases hq₁;
    by_cases hrp : r.LM ∣ p.LM; simp [hrp] at hp₁,
    {
        by_cases hp : p.LM = 0,
        {
            rw hq₁ at hq₂,
            simp [hp] at hrp,
            apply absurd hrp hq₂,
        },
        {
            rw hq₁ at hq₂,
            have h_r := red_list_aux_red_LM_lt l' hrp hp (nez_of_LM_nez hq₂),
            rw [hp₁] at h_r, apply absurd h_r (lt_irrefl _),
        },
    },
    {rwa hq₁,},
    {
        by_cases hr : r = 0,
        {simp [reduction, hr] at hp₁, apply red_list_aux_not_div l', assumption',},
        {
            by_cases hp : p.LM = 0,
            {
                simp [hp]at hrp,
                simp [reduction_of_LM_eqz hp hrp hr, zero_red_list_aux] at hp₁,
                simpa [hp₁.symm] using hq₂,
            },
            {
                have h_r := red_list_aux_red_LM_lt l' hrp hp hr,
                rw [hp₁] at h_r, apply absurd h_r (lt_irrefl _),
            },
        },
    },
    {apply red_list_aux_not_div l', assumption'},
end

theorem red_list_not_div : ∀ (p : mv_polynomial σ α) (l : list (mv_polynomial σ α)) (h : red_list p l ≠ 0)
    (q : mv_polynomial σ α) (hq₁ : q ∈ l) (hq₂ : q ≠ 0), q.LM ∤ (red_list p l).LM
| p l := λ h q hq₁ hq₂, begin
    have hq₃ := red_list_nez_no_const l p h _ hq₁ hq₂,
    unfold red_list at ⊢ h,
    by_cases hp₁ : red_list_aux p l = p;
    by_cases hp₂ : p.LM = 0;
    simp [hp₁, hp₂], assumption',
    {apply red_list_aux_not_div _ _ hp₁ _ hq₁ hq₃},
    {
        let : (red_list_aux p l).LM < p.LM, from red_list_aux_LM_lt l p hp₂ hp₁,
        apply red_list_not_div, simp [hp₁, hp₂] at h,
        assumption',
    }
end
using_well_founded
{ rel_tac := λ _ _, `[exact ⟨_, inv_image.wf (λ a, a.1.LM) _inst_6.wf⟩]
, dec_tac := tactic.assumption }

end reduction

def s_poly (p q : mv_polynomial σ α) : mv_polynomial σ α :=
    let X := m_lcm (LM p) (LM q) in
    --let Xc := lcm (LC p) (LC q) in
    monomial (X - p.LM) (1 / (LC p)) * p - monomial (X - q.LM) (1 / (LC q)) * q

def s_polyL : mv_polynomial σ α → list (mv_polynomial σ α) → list (mv_polynomial σ α)
| p [] := []
| p (q :: l₁) := s_poly p q :: s_polyL p l₁

def s_polys : list (mv_polynomial σ α) → list (mv_polynomial σ α)
| [] := []
| (a :: l) := s_polyL a l ++ (s_polys l)

lemma mem_s_polyL {p q : mv_polynomial σ α} : ∀ {l : list (mv_polynomial σ α)},
q ∈ l → s_poly p q ∈ s_polyL p l
| [] := by simp
| (hd :: tl) := begin
    simp_intros hq [s_polyL],
    cases hq,
    {simp [hq]},
    {simp [mem_s_polyL hq]}
end

lemma s_poly_comm {p q : mv_polynomial σ α} : s_poly p q = -(s_poly q p) :=
by simp [s_poly, m_lcm_comm]

set_option class.instance_max_depth 50
theorem ideal_increase (l : list (mv_polynomial σ α)) (p : mv_polynomial σ α) (h : red_list p l ≠ 0) :
    monomial_ideal l < monomial_ideal (list.cons (red_list p l) l) :=
begin
    simp [lt_iff_le_and_ne],
    refine ⟨by apply ideal.span_mono; simp, _⟩,
    apply ideal.ne_of_not_mem_mem (red_list p l).LT,
    {
        intro h_mem,
        rcases monomial_mem_ideal (by rwa ←LC_nez_iff) l h_mem with ⟨q, ⟨hq₁, hq₂⟩, hq₃⟩,
        apply red_list_not_div p l h, assumption',
    },
    {
        simp [monomial_ideal, ideal.mem_span_insert],
        refine ⟨1, 0, by simp, by simp⟩,
    }
end

def buchberger : (list (mv_polynomial σ α) × list (mv_polynomial σ α)) → list (mv_polynomial σ α)
| ⟨l₁, []⟩ := l₁
| ⟨l₁, (p :: l₂)⟩ :=
    let lex := prod.lex ((>) : ideal (mv_polynomial σ α) → ideal (mv_polynomial σ α) → Prop) nat.lt in
    let a := red_list p l₁ in
    if h : a = 0
    then
        have lex ⟨monomial_ideal l₁, l₂.length⟩ ⟨monomial_ideal l₁, (list.cons p l₂).length⟩ :=
            by right; rw [list.length_cons]; apply nat.lt_succ_self,
        buchberger ⟨l₁, l₂⟩
    else
        have lex ⟨monomial_ideal (list.cons a l₁), (s_polyL a l₁ ++ l₂).length⟩ ⟨monomial_ideal l₁, (list.cons p l₂).length⟩ :=
            by left; exact ideal_increase l₁ p h,
        buchberger ⟨a :: l₁, s_polyL a l₁ ++ l₂⟩
using_well_founded
{ rel_tac := λ _ _,
`[exact ⟨_, inv_image.wf (λ ⟨l₁, l₂⟩, prod.mk (monomial_ideal l₁) l₂.length) (prod.lex_wf ideal_wf nat.lt_wf)⟩ ]
, dec_tac := tactic.assumption }

end buch


/- The tactic search_mem_list defined at back.lean does
   not update the tactic_state. More importantly, it does not change
   the set of goals that need to be solved.
   It is also possible to write a very compact search_mem_list on top of the
   apply tactic. This version will create subgoals while searching for
   a proof of (a ∈ e). -/
open list expr tactic

universe variable u

/- We change the implicit arguments of in_tail and in_head.
   The goal is to allow us to create in_tail and in_head application using
   quotation without having information about the expected type. -/
lemma in_tail  {α : Type u} {a : α} (b : α) {l : list α}      : a ∈ l → a ∈ b::l :=
mem_cons_of_mem _

lemma in_head  {α : Type u} (a : α) (l : list α)              : a ∈ a::l :=
mem_cons_self _ _

lemma in_left  {α : Type u} {a : α}   {l : list α} (r : list α) : a ∈ l → a ∈ l ++ r :=
mem_append_left _

lemma in_right {α : Type u} {a : α}   (l : list α) {r : list α} : a ∈ r → a ∈ l ++ r :=
mem_append_right _

/- The command `declare_trace` add a new trace.search_mem_list to Lean -/
declare_trace search_mem_list

/- In Lean, we can only reference a function 'f' while defining 'f' when we use
   recursive equation compiler. This is true also for meta definitions.
   Thus, we cannot write a tactic such as
       meta def f : tactic unit :=
       ... f ...
   that invokes itself but it is not defined using the equational compiler.
   We workaround this issue by defining it as
       meta def f : unit → tactic unit
       | () := ... f () ...
-/

meta def mk_mem_list_rec : unit → tactic unit
| () :=
when_tracing `search_mem_list (do t ← target, f ← pp t, trace (to_fmt "search " ++ f))
>> (assumption
    <|>
    /- The notation `[t] allows us to use the Lean "tactic interactive mode" inside regular tactic.
       In the following example `[apply in_left] is syntax sugar for
           tactic.interactive.apply `(in_left)
    -/
    (`[apply in_left] >> mk_mem_list_rec ())
    <|>
    (`[apply in_right] >> mk_mem_list_rec ())
    <|>
    (`[apply in_head])
    <|>
    (`[apply in_tail] >> mk_mem_list_rec ()))
/- The tactic `now` fails if we still have goals to be solved -/
>> done

meta def mk_mem_list : tactic unit :=
solve1 (mk_mem_list_rec ())

set_option trace.search_mem_list true

example (a b c : nat) : a ∈ [b, c] ++ [b, a, b] :=
by mk_mem_list

example (a b c : nat) : a ∈ [b, c] ++ [b, a+0, b] :=
by mk_mem_list

example (a b c : nat) : a ∈ [b, c] ++ [b, c, c] ++ [b, a+0, b] :=
by mk_mem_list

--- my example
example (a b c : nat) : a ∈ [b, c] ++ [b, c+0, c] ++ [b, a+1, b] :=
by mk_mem_list

example (a b c : nat) (l : list nat) : a ∈ l → a ∈ [b, c] ++ b::l :=
begin intros, mk_mem_list end

example (a b c : nat) (l₁ l₂ : list nat) : a ∈ l₁ → a ∈ b::b::c::l₂ ++ b::c::l₁ ++ [c, c, b] :=
begin intros, mk_mem_list end


/-
Copyright (c) 2014 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Leonardo de Moura, Floris van Doorn, Yury Kudryashov, Neil Strickland

! This file was ported from Lean 3 source module algebra.ring.basic
! leanprover-community/mathlib commit 448144f7ae193a8990cb7473c9e9a01990f64ac7
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.Ring.Defs
import Mathbin.Algebra.Hom.Group
import Mathbin.Algebra.Opposites

/-!
# Semirings and rings

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

This file gives lemmas about semirings, rings and domains.
This is analogous to `algebra.group.basic`,
the difference being that the former is about `+` and `*` separately, while
the present file is about their interaction.

For the definitions of semirings and rings see `algebra.ring.defs`.

-/

universe u v w x

variable {α : Type u} {β : Type v} {γ : Type w} {R : Type x}

open Function

namespace AddHom

/- warning: add_hom.mul_left -> AddHom.mulLeft is a dubious translation:
lean 3 declaration is
  forall {R : Type.{u1}} [_inst_1 : Distrib.{u1} R], R -> (AddHom.{u1, u1} R R (Distrib.toHasAdd.{u1} R _inst_1) (Distrib.toHasAdd.{u1} R _inst_1))
but is expected to have type
  forall {R : Type.{u1}} [_inst_1 : Distrib.{u1} R], R -> (AddHom.{u1, u1} R R (Distrib.toAdd.{u1} R _inst_1) (Distrib.toAdd.{u1} R _inst_1))
Case conversion may be inaccurate. Consider using '#align add_hom.mul_left AddHom.mulLeftₓ'. -/
/-- Left multiplication by an element of a type with distributive multiplication is an `add_hom`. -/
@[simps (config := { fullyApplied := false })]
def mulLeft {R : Type _} [Distrib R] (r : R) : AddHom R R :=
  ⟨(· * ·) r, mul_add r⟩
#align add_hom.mul_left AddHom.mulLeft

/- warning: add_hom.mul_right -> AddHom.mulRight is a dubious translation:
lean 3 declaration is
  forall {R : Type.{u1}} [_inst_1 : Distrib.{u1} R], R -> (AddHom.{u1, u1} R R (Distrib.toHasAdd.{u1} R _inst_1) (Distrib.toHasAdd.{u1} R _inst_1))
but is expected to have type
  forall {R : Type.{u1}} [_inst_1 : Distrib.{u1} R], R -> (AddHom.{u1, u1} R R (Distrib.toAdd.{u1} R _inst_1) (Distrib.toAdd.{u1} R _inst_1))
Case conversion may be inaccurate. Consider using '#align add_hom.mul_right AddHom.mulRightₓ'. -/
/-- Left multiplication by an element of a type with distributive multiplication is an `add_hom`. -/
@[simps (config := { fullyApplied := false })]
def mulRight {R : Type _} [Distrib R] (r : R) : AddHom R R :=
  ⟨fun a => a * r, fun _ _ => add_mul _ _ r⟩
#align add_hom.mul_right AddHom.mulRight

end AddHom

section AddHomClass

variable {F : Type _} [NonAssocSemiring α] [NonAssocSemiring β] [AddHomClass F α β]

/- warning: map_bit0 -> map_bit0 is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} {F : Type.{u3}} [_inst_1 : NonAssocSemiring.{u1} α] [_inst_2 : NonAssocSemiring.{u2} β] [_inst_3 : AddHomClass.{u3, u1, u2} F α β (Distrib.toHasAdd.{u1} α (NonUnitalNonAssocSemiring.toDistrib.{u1} α (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} α _inst_1))) (Distrib.toHasAdd.{u2} β (NonUnitalNonAssocSemiring.toDistrib.{u2} β (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u2} β _inst_2)))] (f : F) (a : α), Eq.{succ u2} β (coeFn.{succ u3, max (succ u1) (succ u2)} F (fun (_x : F) => α -> β) (FunLike.hasCoeToFun.{succ u3, succ u1, succ u2} F α (fun (_x : α) => β) (AddHomClass.toFunLike.{u3, u1, u2} F α β (Distrib.toHasAdd.{u1} α (NonUnitalNonAssocSemiring.toDistrib.{u1} α (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} α _inst_1))) (Distrib.toHasAdd.{u2} β (NonUnitalNonAssocSemiring.toDistrib.{u2} β (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u2} β _inst_2))) _inst_3)) f (bit0.{u1} α (Distrib.toHasAdd.{u1} α (NonUnitalNonAssocSemiring.toDistrib.{u1} α (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} α _inst_1))) a)) (bit0.{u2} β (Distrib.toHasAdd.{u2} β (NonUnitalNonAssocSemiring.toDistrib.{u2} β (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u2} β _inst_2))) (coeFn.{succ u3, max (succ u1) (succ u2)} F (fun (_x : F) => α -> β) (FunLike.hasCoeToFun.{succ u3, succ u1, succ u2} F α (fun (_x : α) => β) (AddHomClass.toFunLike.{u3, u1, u2} F α β (Distrib.toHasAdd.{u1} α (NonUnitalNonAssocSemiring.toDistrib.{u1} α (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} α _inst_1))) (Distrib.toHasAdd.{u2} β (NonUnitalNonAssocSemiring.toDistrib.{u2} β (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u2} β _inst_2))) _inst_3)) f a))
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u3}} {F : Type.{u1}} [_inst_1 : NonAssocSemiring.{u2} α] [_inst_2 : NonAssocSemiring.{u3} β] [_inst_3 : AddHomClass.{u1, u2, u3} F α β (Distrib.toAdd.{u2} α (NonUnitalNonAssocSemiring.toDistrib.{u2} α (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u2} α _inst_1))) (Distrib.toAdd.{u3} β (NonUnitalNonAssocSemiring.toDistrib.{u3} β (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u3} β _inst_2)))] (f : F) (a : α), Eq.{succ u3} ((fun (x._@.Mathlib.Algebra.Hom.Group._hyg.403 : α) => β) (bit0.{u2} α (Distrib.toAdd.{u2} α (NonUnitalNonAssocSemiring.toDistrib.{u2} α (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u2} α _inst_1))) a)) (FunLike.coe.{succ u1, succ u2, succ u3} F α (fun (_x : α) => (fun (x._@.Mathlib.Algebra.Hom.Group._hyg.403 : α) => β) _x) (AddHomClass.toFunLike.{u1, u2, u3} F α β (Distrib.toAdd.{u2} α (NonUnitalNonAssocSemiring.toDistrib.{u2} α (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u2} α _inst_1))) (Distrib.toAdd.{u3} β (NonUnitalNonAssocSemiring.toDistrib.{u3} β (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u3} β _inst_2))) _inst_3) f (bit0.{u2} α (Distrib.toAdd.{u2} α (NonUnitalNonAssocSemiring.toDistrib.{u2} α (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u2} α _inst_1))) a)) (bit0.{u3} ((fun (x._@.Mathlib.Algebra.Hom.Group._hyg.403 : α) => β) a) (Distrib.toAdd.{u3} ((fun (x._@.Mathlib.Algebra.Hom.Group._hyg.403 : α) => β) a) (NonUnitalNonAssocSemiring.toDistrib.{u3} ((fun (x._@.Mathlib.Algebra.Hom.Group._hyg.403 : α) => β) a) (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u3} ((fun (x._@.Mathlib.Algebra.Hom.Group._hyg.403 : α) => β) a) _inst_2))) (FunLike.coe.{succ u1, succ u2, succ u3} F α (fun (_x : α) => (fun (x._@.Mathlib.Algebra.Hom.Group._hyg.403 : α) => β) _x) (AddHomClass.toFunLike.{u1, u2, u3} F α β (Distrib.toAdd.{u2} α (NonUnitalNonAssocSemiring.toDistrib.{u2} α (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u2} α _inst_1))) (Distrib.toAdd.{u3} β (NonUnitalNonAssocSemiring.toDistrib.{u3} β (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u3} β _inst_2))) _inst_3) f a))
Case conversion may be inaccurate. Consider using '#align map_bit0 map_bit0ₓ'. -/
/-- Additive homomorphisms preserve `bit0`. -/
@[simp]
theorem map_bit0 (f : F) (a : α) : (f (bit0 a) : β) = bit0 (f a) :=
  map_add _ _ _
#align map_bit0 map_bit0

end AddHomClass

namespace AddMonoidHom

#print AddMonoidHom.mulLeft /-
/-- Left multiplication by an element of a (semi)ring is an `add_monoid_hom` -/
def mulLeft {R : Type _} [NonUnitalNonAssocSemiring R] (r : R) : R →+ R
    where
  toFun := (· * ·) r
  map_zero' := MulZeroClass.mul_zero r
  map_add' := mul_add r
#align add_monoid_hom.mul_left AddMonoidHom.mulLeft
-/

/- warning: add_monoid_hom.coe_mul_left -> AddMonoidHom.coe_mul_left is a dubious translation:
lean 3 declaration is
  forall {R : Type.{u1}} [_inst_1 : NonUnitalNonAssocSemiring.{u1} R] (r : R), Eq.{succ u1} (R -> R) (coeFn.{succ u1, succ u1} (AddMonoidHom.{u1, u1} R R (AddMonoid.toAddZeroClass.{u1} R (AddCommMonoid.toAddMonoid.{u1} R (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} R _inst_1))) (AddMonoid.toAddZeroClass.{u1} R (AddCommMonoid.toAddMonoid.{u1} R (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} R _inst_1)))) (fun (_x : AddMonoidHom.{u1, u1} R R (AddMonoid.toAddZeroClass.{u1} R (AddCommMonoid.toAddMonoid.{u1} R (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} R _inst_1))) (AddMonoid.toAddZeroClass.{u1} R (AddCommMonoid.toAddMonoid.{u1} R (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} R _inst_1)))) => R -> R) (AddMonoidHom.hasCoeToFun.{u1, u1} R R (AddMonoid.toAddZeroClass.{u1} R (AddCommMonoid.toAddMonoid.{u1} R (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} R _inst_1))) (AddMonoid.toAddZeroClass.{u1} R (AddCommMonoid.toAddMonoid.{u1} R (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} R _inst_1)))) (AddMonoidHom.mulLeft.{u1} R _inst_1 r)) (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (Distrib.toHasMul.{u1} R (NonUnitalNonAssocSemiring.toDistrib.{u1} R _inst_1))) r)
but is expected to have type
  forall {R : Type.{u1}} [_inst_1 : NonUnitalNonAssocSemiring.{u1} R] (r : R), Eq.{succ u1} (forall (ᾰ : R), (fun (x._@.Mathlib.Algebra.Hom.Group._hyg.403 : R) => R) ᾰ) (FunLike.coe.{succ u1, succ u1, succ u1} (AddMonoidHom.{u1, u1} R R (AddMonoid.toAddZeroClass.{u1} R (AddCommMonoid.toAddMonoid.{u1} R (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} R _inst_1))) (AddMonoid.toAddZeroClass.{u1} R (AddCommMonoid.toAddMonoid.{u1} R (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} R _inst_1)))) R (fun (_x : R) => (fun (x._@.Mathlib.Algebra.Hom.Group._hyg.403 : R) => R) _x) (AddHomClass.toFunLike.{u1, u1, u1} (AddMonoidHom.{u1, u1} R R (AddMonoid.toAddZeroClass.{u1} R (AddCommMonoid.toAddMonoid.{u1} R (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} R _inst_1))) (AddMonoid.toAddZeroClass.{u1} R (AddCommMonoid.toAddMonoid.{u1} R (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} R _inst_1)))) R R (AddZeroClass.toAdd.{u1} R (AddMonoid.toAddZeroClass.{u1} R (AddCommMonoid.toAddMonoid.{u1} R (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} R _inst_1)))) (AddZeroClass.toAdd.{u1} R (AddMonoid.toAddZeroClass.{u1} R (AddCommMonoid.toAddMonoid.{u1} R (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} R _inst_1)))) (AddMonoidHomClass.toAddHomClass.{u1, u1, u1} (AddMonoidHom.{u1, u1} R R (AddMonoid.toAddZeroClass.{u1} R (AddCommMonoid.toAddMonoid.{u1} R (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} R _inst_1))) (AddMonoid.toAddZeroClass.{u1} R (AddCommMonoid.toAddMonoid.{u1} R (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} R _inst_1)))) R R (AddMonoid.toAddZeroClass.{u1} R (AddCommMonoid.toAddMonoid.{u1} R (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} R _inst_1))) (AddMonoid.toAddZeroClass.{u1} R (AddCommMonoid.toAddMonoid.{u1} R (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} R _inst_1))) (AddMonoidHom.addMonoidHomClass.{u1, u1} R R (AddMonoid.toAddZeroClass.{u1} R (AddCommMonoid.toAddMonoid.{u1} R (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} R _inst_1))) (AddMonoid.toAddZeroClass.{u1} R (AddCommMonoid.toAddMonoid.{u1} R (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} R _inst_1)))))) (AddMonoidHom.mulLeft.{u1} R _inst_1 r)) (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (NonUnitalNonAssocSemiring.toMul.{u1} R _inst_1)) r)
Case conversion may be inaccurate. Consider using '#align add_monoid_hom.coe_mul_left AddMonoidHom.coe_mul_leftₓ'. -/
@[simp]
theorem coe_mul_left {R : Type _} [NonUnitalNonAssocSemiring R] (r : R) :
    ⇑(mulLeft r) = (· * ·) r :=
  rfl
#align add_monoid_hom.coe_mul_left AddMonoidHom.coe_mul_left

#print AddMonoidHom.mulRight /-
/-- Right multiplication by an element of a (semi)ring is an `add_monoid_hom` -/
def mulRight {R : Type _} [NonUnitalNonAssocSemiring R] (r : R) : R →+ R
    where
  toFun a := a * r
  map_zero' := MulZeroClass.zero_mul r
  map_add' _ _ := add_mul _ _ r
#align add_monoid_hom.mul_right AddMonoidHom.mulRight
-/

/- warning: add_monoid_hom.coe_mul_right -> AddMonoidHom.coe_mul_right is a dubious translation:
lean 3 declaration is
  forall {R : Type.{u1}} [_inst_1 : NonUnitalNonAssocSemiring.{u1} R] (r : R), Eq.{succ u1} (R -> R) (coeFn.{succ u1, succ u1} (AddMonoidHom.{u1, u1} R R (AddMonoid.toAddZeroClass.{u1} R (AddCommMonoid.toAddMonoid.{u1} R (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} R _inst_1))) (AddMonoid.toAddZeroClass.{u1} R (AddCommMonoid.toAddMonoid.{u1} R (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} R _inst_1)))) (fun (_x : AddMonoidHom.{u1, u1} R R (AddMonoid.toAddZeroClass.{u1} R (AddCommMonoid.toAddMonoid.{u1} R (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} R _inst_1))) (AddMonoid.toAddZeroClass.{u1} R (AddCommMonoid.toAddMonoid.{u1} R (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} R _inst_1)))) => R -> R) (AddMonoidHom.hasCoeToFun.{u1, u1} R R (AddMonoid.toAddZeroClass.{u1} R (AddCommMonoid.toAddMonoid.{u1} R (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} R _inst_1))) (AddMonoid.toAddZeroClass.{u1} R (AddCommMonoid.toAddMonoid.{u1} R (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} R _inst_1)))) (AddMonoidHom.mulRight.{u1} R _inst_1 r)) (fun (_x : R) => HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (Distrib.toHasMul.{u1} R (NonUnitalNonAssocSemiring.toDistrib.{u1} R _inst_1))) _x r)
but is expected to have type
  forall {R : Type.{u1}} [_inst_1 : NonUnitalNonAssocSemiring.{u1} R] (r : R), Eq.{succ u1} (forall (ᾰ : R), (fun (x._@.Mathlib.Algebra.Hom.Group._hyg.403 : R) => R) ᾰ) (FunLike.coe.{succ u1, succ u1, succ u1} (AddMonoidHom.{u1, u1} R R (AddMonoid.toAddZeroClass.{u1} R (AddCommMonoid.toAddMonoid.{u1} R (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} R _inst_1))) (AddMonoid.toAddZeroClass.{u1} R (AddCommMonoid.toAddMonoid.{u1} R (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} R _inst_1)))) R (fun (_x : R) => (fun (x._@.Mathlib.Algebra.Hom.Group._hyg.403 : R) => R) _x) (AddHomClass.toFunLike.{u1, u1, u1} (AddMonoidHom.{u1, u1} R R (AddMonoid.toAddZeroClass.{u1} R (AddCommMonoid.toAddMonoid.{u1} R (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} R _inst_1))) (AddMonoid.toAddZeroClass.{u1} R (AddCommMonoid.toAddMonoid.{u1} R (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} R _inst_1)))) R R (AddZeroClass.toAdd.{u1} R (AddMonoid.toAddZeroClass.{u1} R (AddCommMonoid.toAddMonoid.{u1} R (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} R _inst_1)))) (AddZeroClass.toAdd.{u1} R (AddMonoid.toAddZeroClass.{u1} R (AddCommMonoid.toAddMonoid.{u1} R (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} R _inst_1)))) (AddMonoidHomClass.toAddHomClass.{u1, u1, u1} (AddMonoidHom.{u1, u1} R R (AddMonoid.toAddZeroClass.{u1} R (AddCommMonoid.toAddMonoid.{u1} R (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} R _inst_1))) (AddMonoid.toAddZeroClass.{u1} R (AddCommMonoid.toAddMonoid.{u1} R (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} R _inst_1)))) R R (AddMonoid.toAddZeroClass.{u1} R (AddCommMonoid.toAddMonoid.{u1} R (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} R _inst_1))) (AddMonoid.toAddZeroClass.{u1} R (AddCommMonoid.toAddMonoid.{u1} R (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} R _inst_1))) (AddMonoidHom.addMonoidHomClass.{u1, u1} R R (AddMonoid.toAddZeroClass.{u1} R (AddCommMonoid.toAddMonoid.{u1} R (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} R _inst_1))) (AddMonoid.toAddZeroClass.{u1} R (AddCommMonoid.toAddMonoid.{u1} R (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} R _inst_1)))))) (AddMonoidHom.mulRight.{u1} R _inst_1 r)) (fun (_x : R) => HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (NonUnitalNonAssocSemiring.toMul.{u1} R _inst_1)) _x r)
Case conversion may be inaccurate. Consider using '#align add_monoid_hom.coe_mul_right AddMonoidHom.coe_mul_rightₓ'. -/
@[simp]
theorem coe_mul_right {R : Type _} [NonUnitalNonAssocSemiring R] (r : R) :
    ⇑(mulRight r) = (· * r) :=
  rfl
#align add_monoid_hom.coe_mul_right AddMonoidHom.coe_mul_right

/- warning: add_monoid_hom.mul_right_apply -> AddMonoidHom.mul_right_apply is a dubious translation:
lean 3 declaration is
  forall {R : Type.{u1}} [_inst_1 : NonUnitalNonAssocSemiring.{u1} R] (a : R) (r : R), Eq.{succ u1} R (coeFn.{succ u1, succ u1} (AddMonoidHom.{u1, u1} R R (AddMonoid.toAddZeroClass.{u1} R (AddCommMonoid.toAddMonoid.{u1} R (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} R _inst_1))) (AddMonoid.toAddZeroClass.{u1} R (AddCommMonoid.toAddMonoid.{u1} R (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} R _inst_1)))) (fun (_x : AddMonoidHom.{u1, u1} R R (AddMonoid.toAddZeroClass.{u1} R (AddCommMonoid.toAddMonoid.{u1} R (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} R _inst_1))) (AddMonoid.toAddZeroClass.{u1} R (AddCommMonoid.toAddMonoid.{u1} R (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} R _inst_1)))) => R -> R) (AddMonoidHom.hasCoeToFun.{u1, u1} R R (AddMonoid.toAddZeroClass.{u1} R (AddCommMonoid.toAddMonoid.{u1} R (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} R _inst_1))) (AddMonoid.toAddZeroClass.{u1} R (AddCommMonoid.toAddMonoid.{u1} R (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} R _inst_1)))) (AddMonoidHom.mulRight.{u1} R _inst_1 r) a) (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (Distrib.toHasMul.{u1} R (NonUnitalNonAssocSemiring.toDistrib.{u1} R _inst_1))) a r)
but is expected to have type
  forall {R : Type.{u1}} [_inst_1 : NonUnitalNonAssocSemiring.{u1} R] (a : R) (r : R), Eq.{succ u1} ((fun (x._@.Mathlib.Algebra.Hom.Group._hyg.403 : R) => R) a) (FunLike.coe.{succ u1, succ u1, succ u1} (AddMonoidHom.{u1, u1} R R (AddMonoid.toAddZeroClass.{u1} R (AddCommMonoid.toAddMonoid.{u1} R (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} R _inst_1))) (AddMonoid.toAddZeroClass.{u1} R (AddCommMonoid.toAddMonoid.{u1} R (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} R _inst_1)))) R (fun (_x : R) => (fun (x._@.Mathlib.Algebra.Hom.Group._hyg.403 : R) => R) _x) (AddHomClass.toFunLike.{u1, u1, u1} (AddMonoidHom.{u1, u1} R R (AddMonoid.toAddZeroClass.{u1} R (AddCommMonoid.toAddMonoid.{u1} R (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} R _inst_1))) (AddMonoid.toAddZeroClass.{u1} R (AddCommMonoid.toAddMonoid.{u1} R (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} R _inst_1)))) R R (AddZeroClass.toAdd.{u1} R (AddMonoid.toAddZeroClass.{u1} R (AddCommMonoid.toAddMonoid.{u1} R (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} R _inst_1)))) (AddZeroClass.toAdd.{u1} R (AddMonoid.toAddZeroClass.{u1} R (AddCommMonoid.toAddMonoid.{u1} R (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} R _inst_1)))) (AddMonoidHomClass.toAddHomClass.{u1, u1, u1} (AddMonoidHom.{u1, u1} R R (AddMonoid.toAddZeroClass.{u1} R (AddCommMonoid.toAddMonoid.{u1} R (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} R _inst_1))) (AddMonoid.toAddZeroClass.{u1} R (AddCommMonoid.toAddMonoid.{u1} R (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} R _inst_1)))) R R (AddMonoid.toAddZeroClass.{u1} R (AddCommMonoid.toAddMonoid.{u1} R (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} R _inst_1))) (AddMonoid.toAddZeroClass.{u1} R (AddCommMonoid.toAddMonoid.{u1} R (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} R _inst_1))) (AddMonoidHom.addMonoidHomClass.{u1, u1} R R (AddMonoid.toAddZeroClass.{u1} R (AddCommMonoid.toAddMonoid.{u1} R (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} R _inst_1))) (AddMonoid.toAddZeroClass.{u1} R (AddCommMonoid.toAddMonoid.{u1} R (NonUnitalNonAssocSemiring.toAddCommMonoid.{u1} R _inst_1)))))) (AddMonoidHom.mulRight.{u1} R _inst_1 r) a) (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (NonUnitalNonAssocSemiring.toMul.{u1} R _inst_1)) a r)
Case conversion may be inaccurate. Consider using '#align add_monoid_hom.mul_right_apply AddMonoidHom.mul_right_applyₓ'. -/
theorem mul_right_apply {R : Type _} [NonUnitalNonAssocSemiring R] (a r : R) :
    mulRight r a = a * r :=
  rfl
#align add_monoid_hom.mul_right_apply AddMonoidHom.mul_right_apply

end AddMonoidHom

section HasDistribNeg

section Mul

variable [Mul α] [HasDistribNeg α]

open MulOpposite

instance : HasDistribNeg αᵐᵒᵖ :=
  {
    MulOpposite.hasInvolutiveNeg
      _ with
    neg_mul := fun _ _ => unop_injective <| mul_neg _ _
    mul_neg := fun _ _ => unop_injective <| neg_mul _ _ }

end Mul

section Group

variable [Group α] [HasDistribNeg α]

/- warning: inv_neg' -> inv_neg' is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : Group.{u1} α] [_inst_2 : HasDistribNeg.{u1} α (MulOneClass.toHasMul.{u1} α (Monoid.toMulOneClass.{u1} α (DivInvMonoid.toMonoid.{u1} α (Group.toDivInvMonoid.{u1} α _inst_1))))] (a : α), Eq.{succ u1} α (Inv.inv.{u1} α (DivInvMonoid.toHasInv.{u1} α (Group.toDivInvMonoid.{u1} α _inst_1)) (Neg.neg.{u1} α (InvolutiveNeg.toHasNeg.{u1} α (HasDistribNeg.toHasInvolutiveNeg.{u1} α (MulOneClass.toHasMul.{u1} α (Monoid.toMulOneClass.{u1} α (DivInvMonoid.toMonoid.{u1} α (Group.toDivInvMonoid.{u1} α _inst_1)))) _inst_2)) a)) (Neg.neg.{u1} α (InvolutiveNeg.toHasNeg.{u1} α (HasDistribNeg.toHasInvolutiveNeg.{u1} α (MulOneClass.toHasMul.{u1} α (Monoid.toMulOneClass.{u1} α (DivInvMonoid.toMonoid.{u1} α (Group.toDivInvMonoid.{u1} α _inst_1)))) _inst_2)) (Inv.inv.{u1} α (DivInvMonoid.toHasInv.{u1} α (Group.toDivInvMonoid.{u1} α _inst_1)) a))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : Group.{u1} α] [_inst_2 : HasDistribNeg.{u1} α (MulOneClass.toMul.{u1} α (Monoid.toMulOneClass.{u1} α (DivInvMonoid.toMonoid.{u1} α (Group.toDivInvMonoid.{u1} α _inst_1))))] (a : α), Eq.{succ u1} α (Inv.inv.{u1} α (InvOneClass.toInv.{u1} α (DivInvOneMonoid.toInvOneClass.{u1} α (DivisionMonoid.toDivInvOneMonoid.{u1} α (Group.toDivisionMonoid.{u1} α _inst_1)))) (Neg.neg.{u1} α (InvolutiveNeg.toNeg.{u1} α (HasDistribNeg.toInvolutiveNeg.{u1} α (MulOneClass.toMul.{u1} α (Monoid.toMulOneClass.{u1} α (DivInvMonoid.toMonoid.{u1} α (Group.toDivInvMonoid.{u1} α _inst_1)))) _inst_2)) a)) (Neg.neg.{u1} α (InvolutiveNeg.toNeg.{u1} α (HasDistribNeg.toInvolutiveNeg.{u1} α (MulOneClass.toMul.{u1} α (Monoid.toMulOneClass.{u1} α (DivInvMonoid.toMonoid.{u1} α (Group.toDivInvMonoid.{u1} α _inst_1)))) _inst_2)) (Inv.inv.{u1} α (InvOneClass.toInv.{u1} α (DivInvOneMonoid.toInvOneClass.{u1} α (DivisionMonoid.toDivInvOneMonoid.{u1} α (Group.toDivisionMonoid.{u1} α _inst_1)))) a))
Case conversion may be inaccurate. Consider using '#align inv_neg' inv_neg'ₓ'. -/
@[simp]
theorem inv_neg' (a : α) : (-a)⁻¹ = -a⁻¹ := by
  rw [eq_comm, eq_inv_iff_mul_eq_one, neg_mul, mul_neg, neg_neg, mul_left_inv]
#align inv_neg' inv_neg'

end Group

end HasDistribNeg

section NonUnitalCommRing

variable [NonUnitalCommRing α] {a b c : α}

attribute [local simp] add_assoc add_comm add_left_comm mul_comm

/- warning: Vieta_formula_quadratic -> vieta_formula_quadratic is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : NonUnitalCommRing.{u1} α] {b : α} {c : α} {x : α}, (Eq.{succ u1} α (HAdd.hAdd.{u1, u1, u1} α α α (instHAdd.{u1} α (Distrib.toHasAdd.{u1} α (NonUnitalNonAssocSemiring.toDistrib.{u1} α (NonUnitalNonAssocRing.toNonUnitalNonAssocSemiring.{u1} α (NonUnitalRing.toNonUnitalNonAssocRing.{u1} α (NonUnitalCommRing.toNonUnitalRing.{u1} α _inst_1)))))) (HSub.hSub.{u1, u1, u1} α α α (instHSub.{u1} α (SubNegMonoid.toHasSub.{u1} α (AddGroup.toSubNegMonoid.{u1} α (AddCommGroup.toAddGroup.{u1} α (NonUnitalNonAssocRing.toAddCommGroup.{u1} α (NonUnitalRing.toNonUnitalNonAssocRing.{u1} α (NonUnitalCommRing.toNonUnitalRing.{u1} α _inst_1))))))) (HMul.hMul.{u1, u1, u1} α α α (instHMul.{u1} α (Distrib.toHasMul.{u1} α (NonUnitalNonAssocSemiring.toDistrib.{u1} α (NonUnitalNonAssocRing.toNonUnitalNonAssocSemiring.{u1} α (NonUnitalRing.toNonUnitalNonAssocRing.{u1} α (NonUnitalCommRing.toNonUnitalRing.{u1} α _inst_1)))))) x x) (HMul.hMul.{u1, u1, u1} α α α (instHMul.{u1} α (Distrib.toHasMul.{u1} α (NonUnitalNonAssocSemiring.toDistrib.{u1} α (NonUnitalNonAssocRing.toNonUnitalNonAssocSemiring.{u1} α (NonUnitalRing.toNonUnitalNonAssocRing.{u1} α (NonUnitalCommRing.toNonUnitalRing.{u1} α _inst_1)))))) b x)) c) (OfNat.ofNat.{u1} α 0 (OfNat.mk.{u1} α 0 (Zero.zero.{u1} α (MulZeroClass.toHasZero.{u1} α (NonUnitalNonAssocSemiring.toMulZeroClass.{u1} α (NonUnitalNonAssocRing.toNonUnitalNonAssocSemiring.{u1} α (NonUnitalRing.toNonUnitalNonAssocRing.{u1} α (NonUnitalCommRing.toNonUnitalRing.{u1} α _inst_1))))))))) -> (Exists.{succ u1} α (fun (y : α) => And (Eq.{succ u1} α (HAdd.hAdd.{u1, u1, u1} α α α (instHAdd.{u1} α (Distrib.toHasAdd.{u1} α (NonUnitalNonAssocSemiring.toDistrib.{u1} α (NonUnitalNonAssocRing.toNonUnitalNonAssocSemiring.{u1} α (NonUnitalRing.toNonUnitalNonAssocRing.{u1} α (NonUnitalCommRing.toNonUnitalRing.{u1} α _inst_1)))))) (HSub.hSub.{u1, u1, u1} α α α (instHSub.{u1} α (SubNegMonoid.toHasSub.{u1} α (AddGroup.toSubNegMonoid.{u1} α (AddCommGroup.toAddGroup.{u1} α (NonUnitalNonAssocRing.toAddCommGroup.{u1} α (NonUnitalRing.toNonUnitalNonAssocRing.{u1} α (NonUnitalCommRing.toNonUnitalRing.{u1} α _inst_1))))))) (HMul.hMul.{u1, u1, u1} α α α (instHMul.{u1} α (Distrib.toHasMul.{u1} α (NonUnitalNonAssocSemiring.toDistrib.{u1} α (NonUnitalNonAssocRing.toNonUnitalNonAssocSemiring.{u1} α (NonUnitalRing.toNonUnitalNonAssocRing.{u1} α (NonUnitalCommRing.toNonUnitalRing.{u1} α _inst_1)))))) y y) (HMul.hMul.{u1, u1, u1} α α α (instHMul.{u1} α (Distrib.toHasMul.{u1} α (NonUnitalNonAssocSemiring.toDistrib.{u1} α (NonUnitalNonAssocRing.toNonUnitalNonAssocSemiring.{u1} α (NonUnitalRing.toNonUnitalNonAssocRing.{u1} α (NonUnitalCommRing.toNonUnitalRing.{u1} α _inst_1)))))) b y)) c) (OfNat.ofNat.{u1} α 0 (OfNat.mk.{u1} α 0 (Zero.zero.{u1} α (MulZeroClass.toHasZero.{u1} α (NonUnitalNonAssocSemiring.toMulZeroClass.{u1} α (NonUnitalNonAssocRing.toNonUnitalNonAssocSemiring.{u1} α (NonUnitalRing.toNonUnitalNonAssocRing.{u1} α (NonUnitalCommRing.toNonUnitalRing.{u1} α _inst_1))))))))) (And (Eq.{succ u1} α (HAdd.hAdd.{u1, u1, u1} α α α (instHAdd.{u1} α (Distrib.toHasAdd.{u1} α (NonUnitalNonAssocSemiring.toDistrib.{u1} α (NonUnitalNonAssocRing.toNonUnitalNonAssocSemiring.{u1} α (NonUnitalRing.toNonUnitalNonAssocRing.{u1} α (NonUnitalCommRing.toNonUnitalRing.{u1} α _inst_1)))))) x y) b) (Eq.{succ u1} α (HMul.hMul.{u1, u1, u1} α α α (instHMul.{u1} α (Distrib.toHasMul.{u1} α (NonUnitalNonAssocSemiring.toDistrib.{u1} α (NonUnitalNonAssocRing.toNonUnitalNonAssocSemiring.{u1} α (NonUnitalRing.toNonUnitalNonAssocRing.{u1} α (NonUnitalCommRing.toNonUnitalRing.{u1} α _inst_1)))))) x y) c))))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : NonUnitalCommRing.{u1} α] {b : α} {c : α} {x : α}, (Eq.{succ u1} α (HAdd.hAdd.{u1, u1, u1} α α α (instHAdd.{u1} α (Distrib.toAdd.{u1} α (NonUnitalNonAssocSemiring.toDistrib.{u1} α (NonUnitalNonAssocRing.toNonUnitalNonAssocSemiring.{u1} α (NonUnitalRing.toNonUnitalNonAssocRing.{u1} α (NonUnitalCommRing.toNonUnitalRing.{u1} α _inst_1)))))) (HSub.hSub.{u1, u1, u1} α α α (instHSub.{u1} α (SubNegMonoid.toSub.{u1} α (AddGroup.toSubNegMonoid.{u1} α (AddCommGroup.toAddGroup.{u1} α (NonUnitalNonAssocRing.toAddCommGroup.{u1} α (NonUnitalRing.toNonUnitalNonAssocRing.{u1} α (NonUnitalCommRing.toNonUnitalRing.{u1} α _inst_1))))))) (HMul.hMul.{u1, u1, u1} α α α (instHMul.{u1} α (NonUnitalNonAssocRing.toMul.{u1} α (NonUnitalRing.toNonUnitalNonAssocRing.{u1} α (NonUnitalCommRing.toNonUnitalRing.{u1} α _inst_1)))) x x) (HMul.hMul.{u1, u1, u1} α α α (instHMul.{u1} α (NonUnitalNonAssocRing.toMul.{u1} α (NonUnitalRing.toNonUnitalNonAssocRing.{u1} α (NonUnitalCommRing.toNonUnitalRing.{u1} α _inst_1)))) b x)) c) (OfNat.ofNat.{u1} α 0 (Zero.toOfNat0.{u1} α (SemigroupWithZero.toZero.{u1} α (NonUnitalSemiring.toSemigroupWithZero.{u1} α (NonUnitalRing.toNonUnitalSemiring.{u1} α (NonUnitalCommRing.toNonUnitalRing.{u1} α _inst_1))))))) -> (Exists.{succ u1} α (fun (y : α) => And (Eq.{succ u1} α (HAdd.hAdd.{u1, u1, u1} α α α (instHAdd.{u1} α (Distrib.toAdd.{u1} α (NonUnitalNonAssocSemiring.toDistrib.{u1} α (NonUnitalNonAssocRing.toNonUnitalNonAssocSemiring.{u1} α (NonUnitalRing.toNonUnitalNonAssocRing.{u1} α (NonUnitalCommRing.toNonUnitalRing.{u1} α _inst_1)))))) (HSub.hSub.{u1, u1, u1} α α α (instHSub.{u1} α (SubNegMonoid.toSub.{u1} α (AddGroup.toSubNegMonoid.{u1} α (AddCommGroup.toAddGroup.{u1} α (NonUnitalNonAssocRing.toAddCommGroup.{u1} α (NonUnitalRing.toNonUnitalNonAssocRing.{u1} α (NonUnitalCommRing.toNonUnitalRing.{u1} α _inst_1))))))) (HMul.hMul.{u1, u1, u1} α α α (instHMul.{u1} α (NonUnitalNonAssocRing.toMul.{u1} α (NonUnitalRing.toNonUnitalNonAssocRing.{u1} α (NonUnitalCommRing.toNonUnitalRing.{u1} α _inst_1)))) y y) (HMul.hMul.{u1, u1, u1} α α α (instHMul.{u1} α (NonUnitalNonAssocRing.toMul.{u1} α (NonUnitalRing.toNonUnitalNonAssocRing.{u1} α (NonUnitalCommRing.toNonUnitalRing.{u1} α _inst_1)))) b y)) c) (OfNat.ofNat.{u1} α 0 (Zero.toOfNat0.{u1} α (SemigroupWithZero.toZero.{u1} α (NonUnitalSemiring.toSemigroupWithZero.{u1} α (NonUnitalRing.toNonUnitalSemiring.{u1} α (NonUnitalCommRing.toNonUnitalRing.{u1} α _inst_1))))))) (And (Eq.{succ u1} α (HAdd.hAdd.{u1, u1, u1} α α α (instHAdd.{u1} α (Distrib.toAdd.{u1} α (NonUnitalNonAssocSemiring.toDistrib.{u1} α (NonUnitalNonAssocRing.toNonUnitalNonAssocSemiring.{u1} α (NonUnitalRing.toNonUnitalNonAssocRing.{u1} α (NonUnitalCommRing.toNonUnitalRing.{u1} α _inst_1)))))) x y) b) (Eq.{succ u1} α (HMul.hMul.{u1, u1, u1} α α α (instHMul.{u1} α (NonUnitalNonAssocRing.toMul.{u1} α (NonUnitalRing.toNonUnitalNonAssocRing.{u1} α (NonUnitalCommRing.toNonUnitalRing.{u1} α _inst_1)))) x y) c))))
Case conversion may be inaccurate. Consider using '#align Vieta_formula_quadratic vieta_formula_quadraticₓ'. -/
/-- Vieta's formula for a quadratic equation, relating the coefficients of the polynomial with
  its roots. This particular version states that if we have a root `x` of a monic quadratic
  polynomial, then there is another root `y` such that `x + y` is negative the `a_1` coefficient
  and `x * y` is the `a_0` coefficient. -/
theorem vieta_formula_quadratic {b c x : α} (h : x * x - b * x + c = 0) :
    ∃ y : α, y * y - b * y + c = 0 ∧ x + y = b ∧ x * y = c :=
  by
  have : c = x * (b - x) := (eq_neg_of_add_eq_zero_right h).trans (by simp [mul_sub, mul_comm])
  refine' ⟨b - x, _, by simp, by rw [this]⟩
  rw [this, sub_add, ← sub_mul, sub_self]
#align Vieta_formula_quadratic vieta_formula_quadratic

end NonUnitalCommRing

/- warning: succ_ne_self -> succ_ne_self is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : NonAssocRing.{u1} α] [_inst_2 : Nontrivial.{u1} α] (a : α), Ne.{succ u1} α (HAdd.hAdd.{u1, u1, u1} α α α (instHAdd.{u1} α (Distrib.toHasAdd.{u1} α (NonUnitalNonAssocSemiring.toDistrib.{u1} α (NonUnitalNonAssocRing.toNonUnitalNonAssocSemiring.{u1} α (NonAssocRing.toNonUnitalNonAssocRing.{u1} α _inst_1))))) a (OfNat.ofNat.{u1} α 1 (OfNat.mk.{u1} α 1 (One.one.{u1} α (AddMonoidWithOne.toOne.{u1} α (AddGroupWithOne.toAddMonoidWithOne.{u1} α (AddCommGroupWithOne.toAddGroupWithOne.{u1} α (NonAssocRing.toAddCommGroupWithOne.{u1} α _inst_1)))))))) a
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : NonAssocRing.{u1} α] [_inst_2 : Nontrivial.{u1} α] (a : α), Ne.{succ u1} α (HAdd.hAdd.{u1, u1, u1} α α α (instHAdd.{u1} α (Distrib.toAdd.{u1} α (NonUnitalNonAssocSemiring.toDistrib.{u1} α (NonUnitalNonAssocRing.toNonUnitalNonAssocSemiring.{u1} α (NonAssocRing.toNonUnitalNonAssocRing.{u1} α _inst_1))))) a (OfNat.ofNat.{u1} α 1 (One.toOfNat1.{u1} α (NonAssocRing.toOne.{u1} α _inst_1)))) a
Case conversion may be inaccurate. Consider using '#align succ_ne_self succ_ne_selfₓ'. -/
theorem succ_ne_self [NonAssocRing α] [Nontrivial α] (a : α) : a + 1 ≠ a := fun h =>
  one_ne_zero ((add_right_inj a).mp (by simp [h]))
#align succ_ne_self succ_ne_self

/- warning: pred_ne_self -> pred_ne_self is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : NonAssocRing.{u1} α] [_inst_2 : Nontrivial.{u1} α] (a : α), Ne.{succ u1} α (HSub.hSub.{u1, u1, u1} α α α (instHSub.{u1} α (SubNegMonoid.toHasSub.{u1} α (AddGroup.toSubNegMonoid.{u1} α (AddGroupWithOne.toAddGroup.{u1} α (AddCommGroupWithOne.toAddGroupWithOne.{u1} α (NonAssocRing.toAddCommGroupWithOne.{u1} α _inst_1)))))) a (OfNat.ofNat.{u1} α 1 (OfNat.mk.{u1} α 1 (One.one.{u1} α (AddMonoidWithOne.toOne.{u1} α (AddGroupWithOne.toAddMonoidWithOne.{u1} α (AddCommGroupWithOne.toAddGroupWithOne.{u1} α (NonAssocRing.toAddCommGroupWithOne.{u1} α _inst_1)))))))) a
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : NonAssocRing.{u1} α] [_inst_2 : Nontrivial.{u1} α] (a : α), Ne.{succ u1} α (HSub.hSub.{u1, u1, u1} α α α (instHSub.{u1} α (AddGroupWithOne.toSub.{u1} α (AddCommGroupWithOne.toAddGroupWithOne.{u1} α (NonAssocRing.toAddCommGroupWithOne.{u1} α _inst_1)))) a (OfNat.ofNat.{u1} α 1 (One.toOfNat1.{u1} α (NonAssocRing.toOne.{u1} α _inst_1)))) a
Case conversion may be inaccurate. Consider using '#align pred_ne_self pred_ne_selfₓ'. -/
theorem pred_ne_self [NonAssocRing α] [Nontrivial α] (a : α) : a - 1 ≠ a := fun h =>
  one_ne_zero (neg_injective ((add_right_inj a).mp (by simpa [sub_eq_add_neg] using h)))
#align pred_ne_self pred_ne_self

section NoZeroDivisors

variable (α)

/- warning: is_left_cancel_mul_zero.to_no_zero_divisors -> IsLeftCancelMulZero.to_noZeroDivisors is a dubious translation:
lean 3 declaration is
  forall (α : Type.{u1}) [_inst_1 : Ring.{u1} α] [_inst_2 : IsLeftCancelMulZero.{u1} α (Distrib.toHasMul.{u1} α (Ring.toDistrib.{u1} α _inst_1)) (MulZeroClass.toHasZero.{u1} α (NonUnitalNonAssocSemiring.toMulZeroClass.{u1} α (NonUnitalNonAssocRing.toNonUnitalNonAssocSemiring.{u1} α (NonAssocRing.toNonUnitalNonAssocRing.{u1} α (Ring.toNonAssocRing.{u1} α _inst_1)))))], NoZeroDivisors.{u1} α (Distrib.toHasMul.{u1} α (Ring.toDistrib.{u1} α _inst_1)) (MulZeroClass.toHasZero.{u1} α (NonUnitalNonAssocSemiring.toMulZeroClass.{u1} α (NonUnitalNonAssocRing.toNonUnitalNonAssocSemiring.{u1} α (NonAssocRing.toNonUnitalNonAssocRing.{u1} α (Ring.toNonAssocRing.{u1} α _inst_1)))))
but is expected to have type
  forall (α : Type.{u1}) [_inst_1 : Ring.{u1} α] [_inst_2 : IsLeftCancelMulZero.{u1} α (NonUnitalNonAssocRing.toMul.{u1} α (NonAssocRing.toNonUnitalNonAssocRing.{u1} α (Ring.toNonAssocRing.{u1} α _inst_1))) (MonoidWithZero.toZero.{u1} α (Semiring.toMonoidWithZero.{u1} α (Ring.toSemiring.{u1} α _inst_1)))], NoZeroDivisors.{u1} α (NonUnitalNonAssocRing.toMul.{u1} α (NonAssocRing.toNonUnitalNonAssocRing.{u1} α (Ring.toNonAssocRing.{u1} α _inst_1))) (MonoidWithZero.toZero.{u1} α (Semiring.toMonoidWithZero.{u1} α (Ring.toSemiring.{u1} α _inst_1)))
Case conversion may be inaccurate. Consider using '#align is_left_cancel_mul_zero.to_no_zero_divisors IsLeftCancelMulZero.to_noZeroDivisorsₓ'. -/
theorem IsLeftCancelMulZero.to_noZeroDivisors [Ring α] [IsLeftCancelMulZero α] : NoZeroDivisors α :=
  by
  refine' ⟨fun x y h => _⟩
  by_cases hx : x = 0
  · left
    exact hx
  · right
    rw [← sub_zero (x * y), ← MulZeroClass.mul_zero x, ← mul_sub] at h
    convert IsLeftCancelMulZero.mul_left_cancel_of_ne_zero hx h
    rw [sub_zero]
#align is_left_cancel_mul_zero.to_no_zero_divisors IsLeftCancelMulZero.to_noZeroDivisors

/- warning: is_right_cancel_mul_zero.to_no_zero_divisors -> IsRightCancelMulZero.to_noZeroDivisors is a dubious translation:
lean 3 declaration is
  forall (α : Type.{u1}) [_inst_1 : Ring.{u1} α] [_inst_2 : IsRightCancelMulZero.{u1} α (Distrib.toHasMul.{u1} α (Ring.toDistrib.{u1} α _inst_1)) (MulZeroClass.toHasZero.{u1} α (NonUnitalNonAssocSemiring.toMulZeroClass.{u1} α (NonUnitalNonAssocRing.toNonUnitalNonAssocSemiring.{u1} α (NonAssocRing.toNonUnitalNonAssocRing.{u1} α (Ring.toNonAssocRing.{u1} α _inst_1)))))], NoZeroDivisors.{u1} α (Distrib.toHasMul.{u1} α (Ring.toDistrib.{u1} α _inst_1)) (MulZeroClass.toHasZero.{u1} α (NonUnitalNonAssocSemiring.toMulZeroClass.{u1} α (NonUnitalNonAssocRing.toNonUnitalNonAssocSemiring.{u1} α (NonAssocRing.toNonUnitalNonAssocRing.{u1} α (Ring.toNonAssocRing.{u1} α _inst_1)))))
but is expected to have type
  forall (α : Type.{u1}) [_inst_1 : Ring.{u1} α] [_inst_2 : IsRightCancelMulZero.{u1} α (NonUnitalNonAssocRing.toMul.{u1} α (NonAssocRing.toNonUnitalNonAssocRing.{u1} α (Ring.toNonAssocRing.{u1} α _inst_1))) (MonoidWithZero.toZero.{u1} α (Semiring.toMonoidWithZero.{u1} α (Ring.toSemiring.{u1} α _inst_1)))], NoZeroDivisors.{u1} α (NonUnitalNonAssocRing.toMul.{u1} α (NonAssocRing.toNonUnitalNonAssocRing.{u1} α (Ring.toNonAssocRing.{u1} α _inst_1))) (MonoidWithZero.toZero.{u1} α (Semiring.toMonoidWithZero.{u1} α (Ring.toSemiring.{u1} α _inst_1)))
Case conversion may be inaccurate. Consider using '#align is_right_cancel_mul_zero.to_no_zero_divisors IsRightCancelMulZero.to_noZeroDivisorsₓ'. -/
theorem IsRightCancelMulZero.to_noZeroDivisors [Ring α] [IsRightCancelMulZero α] :
    NoZeroDivisors α := by
  refine' ⟨fun x y h => _⟩
  by_cases hy : y = 0
  · right
    exact hy
  · left
    rw [← sub_zero (x * y), ← MulZeroClass.zero_mul y, ← sub_mul] at h
    convert IsRightCancelMulZero.mul_right_cancel_of_ne_zero hy h
    rw [sub_zero]
#align is_right_cancel_mul_zero.to_no_zero_divisors IsRightCancelMulZero.to_noZeroDivisors

/- warning: no_zero_divisors.to_is_cancel_mul_zero -> NoZeroDivisors.to_isCancelMulZero is a dubious translation:
lean 3 declaration is
  forall (α : Type.{u1}) [_inst_1 : Ring.{u1} α] [_inst_2 : NoZeroDivisors.{u1} α (Distrib.toHasMul.{u1} α (Ring.toDistrib.{u1} α _inst_1)) (MulZeroClass.toHasZero.{u1} α (NonUnitalNonAssocSemiring.toMulZeroClass.{u1} α (NonUnitalNonAssocRing.toNonUnitalNonAssocSemiring.{u1} α (NonAssocRing.toNonUnitalNonAssocRing.{u1} α (Ring.toNonAssocRing.{u1} α _inst_1)))))], IsCancelMulZero.{u1} α (Distrib.toHasMul.{u1} α (Ring.toDistrib.{u1} α _inst_1)) (MulZeroClass.toHasZero.{u1} α (NonUnitalNonAssocSemiring.toMulZeroClass.{u1} α (NonUnitalNonAssocRing.toNonUnitalNonAssocSemiring.{u1} α (NonAssocRing.toNonUnitalNonAssocRing.{u1} α (Ring.toNonAssocRing.{u1} α _inst_1)))))
but is expected to have type
  forall (α : Type.{u1}) [_inst_1 : Ring.{u1} α] [_inst_2 : NoZeroDivisors.{u1} α (NonUnitalNonAssocRing.toMul.{u1} α (NonAssocRing.toNonUnitalNonAssocRing.{u1} α (Ring.toNonAssocRing.{u1} α _inst_1))) (MonoidWithZero.toZero.{u1} α (Semiring.toMonoidWithZero.{u1} α (Ring.toSemiring.{u1} α _inst_1)))], IsCancelMulZero.{u1} α (NonUnitalNonAssocRing.toMul.{u1} α (NonAssocRing.toNonUnitalNonAssocRing.{u1} α (Ring.toNonAssocRing.{u1} α _inst_1))) (MonoidWithZero.toZero.{u1} α (Semiring.toMonoidWithZero.{u1} α (Ring.toSemiring.{u1} α _inst_1)))
Case conversion may be inaccurate. Consider using '#align no_zero_divisors.to_is_cancel_mul_zero NoZeroDivisors.to_isCancelMulZeroₓ'. -/
instance (priority := 100) NoZeroDivisors.to_isCancelMulZero [Ring α] [NoZeroDivisors α] :
    IsCancelMulZero α
    where
  mul_left_cancel_of_ne_zero a b c ha h :=
    by
    rw [← sub_eq_zero, ← mul_sub] at h
    exact sub_eq_zero.1 ((eq_zero_or_eq_zero_of_mul_eq_zero h).resolve_left ha)
  mul_right_cancel_of_ne_zero a b c hb h :=
    by
    rw [← sub_eq_zero, ← sub_mul] at h
    exact sub_eq_zero.1 ((eq_zero_or_eq_zero_of_mul_eq_zero h).resolve_right hb)
#align no_zero_divisors.to_is_cancel_mul_zero NoZeroDivisors.to_isCancelMulZero

/- warning: no_zero_divisors.to_is_domain -> NoZeroDivisors.to_isDomain is a dubious translation:
lean 3 declaration is
  forall (α : Type.{u1}) [_inst_1 : Ring.{u1} α] [h : Nontrivial.{u1} α] [_inst_2 : NoZeroDivisors.{u1} α (Distrib.toHasMul.{u1} α (Ring.toDistrib.{u1} α _inst_1)) (MulZeroClass.toHasZero.{u1} α (NonUnitalNonAssocSemiring.toMulZeroClass.{u1} α (NonUnitalNonAssocRing.toNonUnitalNonAssocSemiring.{u1} α (NonAssocRing.toNonUnitalNonAssocRing.{u1} α (Ring.toNonAssocRing.{u1} α _inst_1)))))], IsDomain.{u1} α (Ring.toSemiring.{u1} α _inst_1)
but is expected to have type
  forall (α : Type.{u1}) [_inst_1 : Ring.{u1} α] [h : Nontrivial.{u1} α] [_inst_2 : NoZeroDivisors.{u1} α (NonUnitalNonAssocRing.toMul.{u1} α (NonAssocRing.toNonUnitalNonAssocRing.{u1} α (Ring.toNonAssocRing.{u1} α _inst_1))) (MonoidWithZero.toZero.{u1} α (Semiring.toMonoidWithZero.{u1} α (Ring.toSemiring.{u1} α _inst_1)))], IsDomain.{u1} α (Ring.toSemiring.{u1} α _inst_1)
Case conversion may be inaccurate. Consider using '#align no_zero_divisors.to_is_domain NoZeroDivisors.to_isDomainₓ'. -/
theorem NoZeroDivisors.to_isDomain [Ring α] [h : Nontrivial α] [NoZeroDivisors α] : IsDomain α :=
  { NoZeroDivisors.to_isCancelMulZero α, h with }
#align no_zero_divisors.to_is_domain NoZeroDivisors.to_isDomain

/- warning: is_domain.to_no_zero_divisors -> IsDomain.to_noZeroDivisors is a dubious translation:
lean 3 declaration is
  forall (α : Type.{u1}) [_inst_1 : Ring.{u1} α] [_inst_2 : IsDomain.{u1} α (Ring.toSemiring.{u1} α _inst_1)], NoZeroDivisors.{u1} α (Distrib.toHasMul.{u1} α (Ring.toDistrib.{u1} α _inst_1)) (MulZeroClass.toHasZero.{u1} α (NonUnitalNonAssocSemiring.toMulZeroClass.{u1} α (NonUnitalNonAssocRing.toNonUnitalNonAssocSemiring.{u1} α (NonAssocRing.toNonUnitalNonAssocRing.{u1} α (Ring.toNonAssocRing.{u1} α _inst_1)))))
but is expected to have type
  forall (α : Type.{u1}) [_inst_1 : Ring.{u1} α] [_inst_2 : IsDomain.{u1} α (Ring.toSemiring.{u1} α _inst_1)], NoZeroDivisors.{u1} α (NonUnitalNonAssocRing.toMul.{u1} α (NonAssocRing.toNonUnitalNonAssocRing.{u1} α (Ring.toNonAssocRing.{u1} α _inst_1))) (MonoidWithZero.toZero.{u1} α (Semiring.toMonoidWithZero.{u1} α (Ring.toSemiring.{u1} α _inst_1)))
Case conversion may be inaccurate. Consider using '#align is_domain.to_no_zero_divisors IsDomain.to_noZeroDivisorsₓ'. -/
instance (priority := 100) IsDomain.to_noZeroDivisors [Ring α] [IsDomain α] : NoZeroDivisors α :=
  IsRightCancelMulZero.to_noZeroDivisors α
#align is_domain.to_no_zero_divisors IsDomain.to_noZeroDivisors

end NoZeroDivisors


/-
Copyright (c) 2021 Yury G. Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury G. Kudryashov
-/
import geometry.manifold.algebra.structures
import geometry.manifold.bump_function
import topology.paracompact
import topology.partition_of_unity
import topology.shrinking_lemma

/-!
# Smooth partition of unity

In this file we define two structures, `smooth_bump_covering` and `smooth_partition_of_unity`. Both
structures describe coverings of a set by a locally finite family of supports of smooth functions
with some additional properties. The former structure is mostly useful as an intermediate step in
the construction of a smooth partition of unity but some proofs that traditionally deal with a
partition of unity can use a `smooth_bump_covering` as well.

Given a real manifold `M` and its subset `s`, a `smooth_bump_covering ι I M s` is a collection of
`smooth_bump_function`s `f i` indexed by `i : ι` such that

* the center of each `f i` belongs to `s`;
* the family of sets `support (f i)` is locally finite;
* for each `x ∈ s`, there exists `i : ι` such that `f i =ᶠ[𝓝 x] 1`.
In the same settings, a `smooth_partition_of_unity ι I M s` is a collection of smooth nonnegative
functions `f i : C^∞⟮I, M; 𝓘(ℝ), ℝ⟯`, `i : ι`, such that

* the family of sets `support (f i)` is locally finite;
* for each `x ∈ s`, the sum `∑ᶠ i, f i x` equals one;
* for each `x`, the sum `∑ᶠ i, f i x` is less than or equal to one.

We say that `f : smooth_bump_covering ι I M s` is *subordinate* to a map `U : M → set M` if for each
index `i`, we have `tsupport (f i) ⊆ U (f i).c`. This notion is a bit more general than
being subordinate to an open covering of `M`, because we make no assumption about the way `U x`
depends on `x`.

We prove that on a smooth finitely dimensional real manifold with `σ`-compact Hausdorff topology,
for any `U : M → set M` such that `∀ x ∈ s, U x ∈ 𝓝 x` there exists a `smooth_bump_covering ι I M s`
subordinate to `U`. Then we use this fact to prove a similar statement about smooth partitions of
unity.

## Implementation notes

## TODO

* Build a framework for to transfer local definitions to global using partition of unity and use it
  to define, e.g., the integral of a differential form over a manifold.

## Tags

smooth bump function, partition of unity
-/

universes uι uE uH uM

open function filter finite_dimensional set
open_locale topological_space manifold classical filter big_operators

noncomputable theory

variables {ι : Type uι}
{E : Type uE} [normed_group E] [normed_space ℝ E] [finite_dimensional ℝ E]
{H : Type uH} [topological_space H] (I : model_with_corners ℝ E H)
{M : Type uM} [topological_space M] [charted_space H M] [smooth_manifold_with_corners I M]

/-!
### Covering by supports of smooth bump functions

In this section we define `smooth_bump_covering ι I M s` to be a collection of
`smooth_bump_function`s such that their supports is a locally finite family of sets and for each `x
∈ s` some function `f i` from the collection is equal to `1` in a neighborhood of `x`. A covering of
this type is useful to construct a smooth partition of unity and can be used instead of a partition
of unity in some proofs.

We prove that on a smooth finite dimensional real manifold with `σ`-compact Hausdorff topology, for
any `U : M → set M` such that `∀ x ∈ s, U x ∈ 𝓝 x` there exists a `smooth_bump_covering ι I M s`
subordinate to `U`. Then we use this fact to prove a version of the Whitney embedding theorem: any
compact real manifold can be embedded into `ℝ^n` for large enough `n`.  -/

variables (ι M)

/-- We say that a collection of `smooth_bump_function`s is a `smooth_bump_covering` of a set `s` if

* `(f i).c ∈ s` for all `i`;
* the family `λ i, support (f i)` is locally finite;
* for each point `x ∈ s` there exists `i` such that `f i =ᶠ[𝓝 x] 1`;
  in other words, `x` belongs to the interior of `{y | f i y = 1}`;

If `M` is a finite dimensional real manifold which is a sigma-compact Hausdorff topological space,
then for every covering `U : M → set M`, `∀ x, U x ∈ 𝓝 x`, there exists a `smooth_bump_covering`
subordinate to `U`, see `smooth_bump_covering.exists_is_subordinate`.

This covering can be used, e.g., to construct a partition of unity and to prove the weak
Whitney embedding theorem. -/
@[nolint has_inhabited_instance]
structure smooth_bump_covering (s : set M := univ) :=
(c : ι → M)
(to_fun : Π i, smooth_bump_function I (c i))
(c_mem' : ∀ i, c i ∈ s)
(locally_finite' : locally_finite (λ i, support (to_fun i)))
(eventually_eq_one' : ∀ x ∈ s, ∃ i, to_fun i =ᶠ[𝓝 x] 1)

/-- We say that that a collection of functions form a smooth partition of unity on a set `s` if

* all functions are infinitely smooth and nonnegative;
* the family `λ i, support (f i)` is locally finite;
* for all `x ∈ s` the sum `∑ᶠ i, f i x` equals one;
* for all `x`, the sum `∑ᶠ i, f i x` is less than or equal to one. -/
structure smooth_partition_of_unity (s : set M := univ) :=
(to_fun : ι → C^∞⟮I, M; 𝓘(ℝ), ℝ⟯)
(locally_finite' : locally_finite (λ i, support (to_fun i)))
(nonneg' : ∀ i x, 0 ≤ to_fun i x)
(sum_eq_one' : ∀ x ∈ s, ∑ᶠ i, to_fun i x = 1)
(sum_le_one' : ∀ x, ∑ᶠ i, to_fun i x ≤ 1)

variables {ι I M}

namespace smooth_partition_of_unity

variables {s : set M} (f : smooth_partition_of_unity ι I M s)

instance {s : set M} : has_coe_to_fun (smooth_partition_of_unity ι I M s)
  (λ _, ι → C^∞⟮I, M; 𝓘(ℝ), ℝ⟯) :=
⟨smooth_partition_of_unity.to_fun⟩

protected lemma locally_finite : locally_finite (λ i, support (f i)) :=
f.locally_finite'

lemma nonneg (i : ι) (x : M) : 0 ≤ f i x := f.nonneg' i x

lemma sum_eq_one {x} (hx : x ∈ s) : ∑ᶠ i, f i x = 1 := f.sum_eq_one' x hx

lemma sum_le_one (x : M) : ∑ᶠ i, f i x ≤ 1 := f.sum_le_one' x

/-- Reinterpret a smooth partition of unity as a continuous partition of unity. -/
def to_partition_of_unity : partition_of_unity ι M s :=
{ to_fun := λ i, f i, .. f }

lemma smooth_sum : smooth I 𝓘(ℝ) (λ x, ∑ᶠ i, f i x) :=
smooth_finsum (λ i, (f i).smooth) f.locally_finite

lemma le_one (i : ι) (x : M) : f i x ≤ 1 := f.to_partition_of_unity.le_one i x

lemma sum_nonneg (x : M) : 0 ≤ ∑ᶠ i, f i x := f.to_partition_of_unity.sum_nonneg x

/-- A smooth partition of unity `f i` is subordinate to a family of sets `U i` indexed by the same
type if for each `i` the closure of the support of `f i` is a subset of `U i`. -/
def is_subordinate (f : smooth_partition_of_unity ι I M s) (U : ι → set M) :=
∀ i, tsupport (f i) ⊆ U i

@[simp] lemma is_subordinate_to_partition_of_unity {f : smooth_partition_of_unity ι I M s}
  {U : ι → set M} :
  f.to_partition_of_unity.is_subordinate U ↔ f.is_subordinate U :=
iff.rfl

alias is_subordinate_to_partition_of_unity ↔
  _ smooth_partition_of_unity.is_subordinate.to_partition_of_unity

end smooth_partition_of_unity

namespace bump_covering

-- Repeat variables to drop [finite_dimensional ℝ E] and [smooth_manifold_with_corners I M]
lemma smooth_to_partition_of_unity {E : Type uE} [normed_group E] [normed_space ℝ E]
  {H : Type uH} [topological_space H] {I : model_with_corners ℝ E H}
  {M : Type uM} [topological_space M] [charted_space H M] {s : set M}
  (f : bump_covering ι M s) (hf : ∀ i, smooth I 𝓘(ℝ) (f i)) (i : ι) :
  smooth I 𝓘(ℝ) (f.to_partition_of_unity i) :=
(hf i).mul $ smooth_finprod_cond (λ j _, smooth_const.sub (hf j)) $
  by { simp only [mul_support_one_sub], exact f.locally_finite }

variables {s : set M}

/-- A `bump_covering` such that all functions in this covering are smooth generates a smooth
partition of unity.

In our formalization, not every `f : bump_covering ι M s` with smooth functions `f i` is a
`smooth_bump_covering`; instead, a `smooth_bump_covering` is a covering by supports of
`smooth_bump_function`s. So, we define `bump_covering.to_smooth_partition_of_unity`, then reuse it
in `smooth_bump_covering.to_smooth_partition_of_unity`. -/
def to_smooth_partition_of_unity (f : bump_covering ι M s) (hf : ∀ i, smooth I 𝓘(ℝ) (f i)) :
  smooth_partition_of_unity ι I M s :=
{ to_fun := λ i, ⟨f.to_partition_of_unity i, f.smooth_to_partition_of_unity hf i⟩,
  .. f.to_partition_of_unity }

@[simp] lemma to_smooth_partition_of_unity_to_partition_of_unity (f : bump_covering ι M s)
  (hf : ∀ i, smooth I 𝓘(ℝ) (f i)) :
  (f.to_smooth_partition_of_unity hf).to_partition_of_unity = f.to_partition_of_unity :=
rfl

@[simp] lemma coe_to_smooth_partition_of_unity (f : bump_covering ι M s)
  (hf : ∀ i, smooth I 𝓘(ℝ) (f i)) (i : ι) :
  ⇑(f.to_smooth_partition_of_unity hf i) = f.to_partition_of_unity i :=
rfl

lemma is_subordinate.to_smooth_partition_of_unity {f : bump_covering ι M s}
  {U : ι → set M} (h : f.is_subordinate U) (hf : ∀ i, smooth I 𝓘(ℝ) (f i)) :
  (f.to_smooth_partition_of_unity hf).is_subordinate U :=
h.to_partition_of_unity

end bump_covering

namespace smooth_bump_covering

variables {s : set M} {U : M → set M} (fs : smooth_bump_covering ι I M s) {I}

instance : has_coe_to_fun (smooth_bump_covering ι I M s)
  (λ x, Π (i : ι), smooth_bump_function I (x.c i)) :=
⟨to_fun⟩

@[simp] lemma coe_mk (c : ι → M) (to_fun : Π i, smooth_bump_function I (c i))
  (h₁ h₂ h₃) : ⇑(mk c to_fun h₁ h₂ h₃ : smooth_bump_covering ι I M s) = to_fun :=
rfl

/--
We say that `f : smooth_bump_covering ι I M s` is *subordinate* to a map `U : M → set M` if for each
index `i`, we have `tsupport (f i) ⊆ U (f i).c`. This notion is a bit more general than
being subordinate to an open covering of `M`, because we make no assumption about the way `U x`
depends on `x`.
-/
def is_subordinate {s : set M} (f : smooth_bump_covering ι I M s) (U : M → set M) :=
∀ i, tsupport (f i) ⊆ U (f.c i)

lemma is_subordinate.support_subset {fs : smooth_bump_covering ι I M s} {U : M → set M}
  (h : fs.is_subordinate U) (i : ι) :
  support (fs i) ⊆ U (fs.c i) :=
subset.trans subset_closure (h i)

variable (I)

/-- Let `M` be a smooth manifold with corners modelled on a finite dimensional real vector space.
Suppose also that `M` is a Hausdorff `σ`-compact topological space. Let `s` be a closed set
in `M` and `U : M → set M` be a collection of sets such that `U x ∈ 𝓝 x` for every `x ∈ s`.
Then there exists a smooth bump covering of `s` that is subordinate to `U`. -/
lemma exists_is_subordinate [t2_space M] [sigma_compact_space M] (hs : is_closed s)
  (hU : ∀ x ∈ s, U x ∈ 𝓝 x) :
  ∃ (ι : Type uM) (f : smooth_bump_covering ι I M s), f.is_subordinate U :=
begin
  -- First we deduce some missing instances
  haveI : locally_compact_space H := I.locally_compact,
  haveI : locally_compact_space M := charted_space.locally_compact H,
  haveI : normal_space M := normal_of_paracompact_t2,
  -- Next we choose a covering by supports of smooth bump functions
  have hB := λ x hx, smooth_bump_function.nhds_basis_support I (hU x hx),
  rcases refinement_of_locally_compact_sigma_compact_of_nhds_basis_set hs hB
    with ⟨ι, c, f, hf, hsub', hfin⟩, choose hcs hfU using hf,
  /- Then we use the shrinking lemma to get a covering by smaller open -/
  rcases exists_subset_Union_closed_subset hs (λ i, (f i).open_support)
    (λ x hx, hfin.point_finite x) hsub' with ⟨V, hsV, hVc, hVf⟩,
  choose r hrR hr using λ i, (f i).exists_r_pos_lt_subset_ball (hVc i) (hVf i),
  refine ⟨ι, ⟨c, λ i, (f i).update_r (r i) (hrR i), hcs, _, λ x hx, _⟩, λ i, _⟩,
  { simpa only [smooth_bump_function.support_update_r] },
  { refine (mem_Union.1 $ hsV hx).imp (λ i hi, _),
    exact ((f i).update_r _ _).eventually_eq_one_of_dist_lt
      ((f i).support_subset_source $ hVf _ hi) (hr i hi).2 },
  { simpa only [coe_mk, smooth_bump_function.support_update_r, tsupport] using hfU i }
end

variables {I M}

protected lemma locally_finite : locally_finite (λ i, support (fs i)) := fs.locally_finite'

protected lemma point_finite (x : M) : {i | fs i x ≠ 0}.finite :=
fs.locally_finite.point_finite x

lemma mem_chart_at_source_of_eq_one {i : ι} {x : M} (h : fs i x = 1) :
  x ∈ (chart_at H (fs.c i)).source :=
(fs i).support_subset_source $ by simp [h]

lemma mem_ext_chart_at_source_of_eq_one {i : ι} {x : M} (h : fs i x = 1) :
  x ∈ (ext_chart_at I (fs.c i)).source :=
by { rw ext_chart_at_source, exact fs.mem_chart_at_source_of_eq_one h }

/-- Index of a bump function such that `fs i =ᶠ[𝓝 x] 1`. -/
def ind (x : M) (hx : x ∈ s) : ι := (fs.eventually_eq_one' x hx).some

lemma eventually_eq_one (x : M) (hx : x ∈ s) : fs (fs.ind x hx) =ᶠ[𝓝 x] 1 :=
(fs.eventually_eq_one' x hx).some_spec

lemma apply_ind (x : M) (hx : x ∈ s) : fs (fs.ind x hx) x = 1 :=
(fs.eventually_eq_one x hx).eq_of_nhds

lemma mem_support_ind (x : M) (hx : x ∈ s) : x ∈ support (fs $ fs.ind x hx) :=
by simp [fs.apply_ind x hx]

lemma mem_chart_at_ind_source (x : M) (hx : x ∈ s) :
  x ∈ (chart_at H (fs.c (fs.ind x hx))).source :=
fs.mem_chart_at_source_of_eq_one (fs.apply_ind x hx)

lemma mem_ext_chart_at_ind_source (x : M) (hx : x ∈ s) :
  x ∈ (ext_chart_at I (fs.c (fs.ind x hx))).source :=
fs.mem_ext_chart_at_source_of_eq_one (fs.apply_ind x hx)

/-- The index type of a `smooth_bump_covering` of a compact manifold is finite. -/
protected def fintype [compact_space M] : fintype ι :=
fs.locally_finite.fintype_of_compact $ λ i, (fs i).nonempty_support

variable [t2_space M]

/-- Reinterpret a `smooth_bump_covering` as a continuous `bump_covering`. Note that not every
`f : bump_covering ι M s` with smooth functions `f i` is a `smooth_bump_covering`. -/
def to_bump_covering : bump_covering ι M s :=
{ to_fun := λ i, ⟨fs i, (fs i).continuous⟩,
  locally_finite' := fs.locally_finite,
  nonneg' := λ i x, (fs i).nonneg,
  le_one' := λ i x, (fs i).le_one,
  eventually_eq_one' := fs.eventually_eq_one' }

@[simp] lemma is_subordinate_to_bump_covering {f : smooth_bump_covering ι I M s} {U : M → set M} :
  f.to_bump_covering.is_subordinate (λ i, U (f.c i)) ↔ f.is_subordinate U :=
iff.rfl

alias is_subordinate_to_bump_covering ↔
  _ smooth_bump_covering.is_subordinate.to_bump_covering

/-- Every `smooth_bump_covering` defines a smooth partition of unity. -/
def to_smooth_partition_of_unity : smooth_partition_of_unity ι I M s :=
fs.to_bump_covering.to_smooth_partition_of_unity (λ i, (fs i).smooth)

lemma to_smooth_partition_of_unity_apply (i : ι) (x : M) :
  fs.to_smooth_partition_of_unity i x = fs i x * ∏ᶠ j (hj : well_ordering_rel j i), (1 - fs j x) :=
rfl

lemma to_smooth_partition_of_unity_eq_mul_prod (i : ι) (x : M) (t : finset ι)
  (ht : ∀ j, well_ordering_rel j i → fs j x ≠ 0 → j ∈ t) :
  fs.to_smooth_partition_of_unity i x =
    fs i x * ∏ j in t.filter (λ j, well_ordering_rel j i), (1 - fs j x) :=
fs.to_bump_covering.to_partition_of_unity_eq_mul_prod i x t ht

lemma exists_finset_to_smooth_partition_of_unity_eventually_eq (i : ι) (x : M) :
  ∃ t : finset ι, fs.to_smooth_partition_of_unity i =ᶠ[𝓝 x]
    fs i * ∏ j in t.filter (λ j, well_ordering_rel j i), (1 - fs j) :=
fs.to_bump_covering.exists_finset_to_partition_of_unity_eventually_eq i x

lemma to_smooth_partition_of_unity_zero_of_zero {i : ι} {x : M} (h : fs i x = 0) :
  fs.to_smooth_partition_of_unity i x = 0 :=
fs.to_bump_covering.to_partition_of_unity_zero_of_zero h

lemma support_to_smooth_partition_of_unity_subset (i : ι) :
  support (fs.to_smooth_partition_of_unity i) ⊆ support (fs i) :=
fs.to_bump_covering.support_to_partition_of_unity_subset i

lemma is_subordinate.to_smooth_partition_of_unity {f : smooth_bump_covering ι I M s} {U : M → set M}
  (h : f.is_subordinate U) :
  f.to_smooth_partition_of_unity.is_subordinate (λ i, U (f.c i)) :=
h.to_bump_covering.to_partition_of_unity

lemma sum_to_smooth_partition_of_unity_eq (x : M) :
  ∑ᶠ i, fs.to_smooth_partition_of_unity i x = 1 - ∏ᶠ i, (1 - fs i x) :=
fs.to_bump_covering.sum_to_partition_of_unity_eq x

end smooth_bump_covering

variable (I)

/-- Given two disjoint closed sets in a Hausdorff σ-compact finite dimensional manifold, there
exists an infinitely smooth function that is equal to `0` on one of them and is equal to one on the
other. -/
lemma exists_smooth_zero_one_of_closed [t2_space M] [sigma_compact_space M] {s t : set M}
  (hs : is_closed s) (ht : is_closed t) (hd : disjoint s t) :
  ∃ f : C^∞⟮I, M; 𝓘(ℝ), ℝ⟯, eq_on f 0 s ∧ eq_on f 1 t ∧ ∀ x, f x ∈ Icc (0 : ℝ) 1 :=
begin
  have : ∀ x ∈ t, sᶜ ∈ 𝓝 x, from λ x hx, hs.is_open_compl.mem_nhds (disjoint_right.1 hd hx),
  rcases smooth_bump_covering.exists_is_subordinate I ht this with ⟨ι, f, hf⟩,
  set g := f.to_smooth_partition_of_unity,
  refine ⟨⟨_, g.smooth_sum⟩, λ x hx, _, λ x, g.sum_eq_one, λ x, ⟨g.sum_nonneg x, g.sum_le_one x⟩⟩,
  suffices : ∀ i, g i x = 0,
    by simp only [this, cont_mdiff_map.coe_fn_mk, finsum_zero, pi.zero_apply],
  refine λ i, f.to_smooth_partition_of_unity_zero_of_zero _,
  exact nmem_support.1 (subset_compl_comm.1 (hf.support_subset i) hx)
end

variable {I}

namespace smooth_partition_of_unity

/-- A `smooth_partition_of_unity` that consists of a single function, uniformly equal to one,
defined as an example for `inhabited` instance. -/
def single (i : ι) (s : set M) : smooth_partition_of_unity ι I M s :=
(bump_covering.single i s).to_smooth_partition_of_unity $ λ j,
  begin
    rcases eq_or_ne j i with rfl|h,
    { simp only [smooth_one, continuous_map.coe_one, bump_covering.coe_single, pi.single_eq_same] },
    { simp only [smooth_zero, bump_covering.coe_single, pi.single_eq_of_ne h,
        continuous_map.coe_zero] }
  end

instance [inhabited ι] (s : set M) : inhabited (smooth_partition_of_unity ι I M s) :=
⟨single default s⟩

variables [t2_space M] [sigma_compact_space M]

/-- If `X` is a paracompact normal topological space and `U` is an open covering of a closed set
`s`, then there exists a `bump_covering ι X s` that is subordinate to `U`. -/
lemma exists_is_subordinate {s : set M} (hs : is_closed s) (U : ι → set M) (ho : ∀ i, is_open (U i))
  (hU : s ⊆ ⋃ i, U i) :
  ∃ f : smooth_partition_of_unity ι I M s, f.is_subordinate U :=
begin
  haveI : locally_compact_space H := I.locally_compact,
  haveI : locally_compact_space M := charted_space.locally_compact H,
  haveI : normal_space M := normal_of_paracompact_t2,
  rcases bump_covering.exists_is_subordinate_of_prop (smooth I 𝓘(ℝ)) _ hs U ho hU
    with ⟨f, hf, hfU⟩,
  { exact ⟨f.to_smooth_partition_of_unity hf, hfU.to_smooth_partition_of_unity hf⟩ },
  { intros s t hs ht hd,
    rcases exists_smooth_zero_one_of_closed I hs ht hd with ⟨f, hf⟩,
    exact ⟨f, f.smooth, hf⟩ }
end

end smooth_partition_of_unity


import tactic --hide
lemma not_iff_imp_false (P : Prop) : ¬ P ↔ P → false := iff.rfl -- hide
lemma contra (P Q : Prop) : (P ∧ ¬ P) → Q := by {cc} --hide

/-Lemma
$¬ \mathrm{true}$ implies $\mathrm{false}$.
-/
lemma not_true_imp_false : ¬ true → false :=
begin
  rw not_iff_imp_false,
  intro h,
  apply h,
  triv,

end