/-
Copyright (c) 2020 Riccardo Brasca. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Riccardo Brasca
-/
import data.polynomial.algebra_map
import data.polynomial.monic

/-!
# Polynomials that lift

Given semirings `R` and `S` with a morphism `f : R →+* S`, we define a subsemiring `lifts` of
`polynomial S` by the image of `ring_hom.of (map f)`.
Then, we prove that a polynomial that lifts can always be lifted to a polynomial of the same degree
and that a monic polynomial that lifts can be lifted to a monic polynomial (of the same degree).

## Main definition

* `lifts (f : R →+* S)` : the subsemiring of polynomials that lift.

## Main results

* `lifts_and_degree_eq` : A polynomial lifts if and only if it can be lifted to a polynomial
of the same degree.
* `lifts_and_degree_eq_and_monic` : A monic polynomial lifts if and only if it can be lifted to a
monic polynomial of the same degree.
* `lifts_iff_alg` : if `R` is commutative, a polynomial lifts if and only if it is in the image of
`map_alg`, where `map_alg : R[X] →ₐ[R] S[X]` is the only `R`-algebra map
that sends `X` to `X`.

## Implementation details

In general `R` and `S` are semiring, so `lifts` is a semiring. In the case of rings, see
`lifts_iff_lifts_ring`.

Since we do not assume `R` to be commutative, we cannot say in general that the set of polynomials
that lift is a subalgebra. (By `lift_iff` this is true if `R` is commutative.)

-/

open_locale classical big_operators polynomial
noncomputable theory

namespace polynomial
universes u v w

section semiring

variables {R : Type u} [semiring R] {S : Type v} [semiring S] {f : R →+* S}

/-- We define the subsemiring of polynomials that lifts as the image of `ring_hom.of (map f)`. -/
def lifts (f : R →+* S) : subsemiring S[X] := ring_hom.srange (map_ring_hom f)

lemma mem_lifts (p : S[X]) : p ∈ lifts f ↔ ∃ (q : R[X]), map f q = p :=
by simp only [coe_map_ring_hom, lifts, ring_hom.mem_srange]

lemma lifts_iff_set_range (p : S[X]) : p ∈ lifts f ↔ p ∈ set.range (map f) :=
by simp only [coe_map_ring_hom, lifts, set.mem_range, ring_hom.mem_srange]

lemma lifts_iff_ring_hom_srange (p : S[X]) : p ∈ lifts f ↔ p ∈ (map_ring_hom f).srange :=
by simp only [coe_map_ring_hom, lifts, set.mem_range, ring_hom.mem_srange]

lemma lifts_iff_coeff_lifts (p : S[X]) : p ∈ lifts f ↔ ∀ (n : ℕ), p.coeff n ∈ set.range f :=
by { rw [lifts_iff_ring_hom_srange, mem_map_srange f], refl }

/--If `(r : R)`, then `C (f r)` lifts. -/
lemma C_mem_lifts (f : R →+* S) (r : R) : (C (f r)) ∈ lifts f :=
⟨C r, by simp only [coe_map_ring_hom, map_C, set.mem_univ, subsemiring.coe_top, eq_self_iff_true,
  and_self]⟩

/-- If `(s : S)` is in the image of `f`, then `C s` lifts. -/
lemma C'_mem_lifts {f : R →+* S} {s : S} (h : s ∈ set.range f) : (C s) ∈ lifts f :=
begin
  obtain ⟨r, rfl⟩ := set.mem_range.1 h,
  use C r,
  simp only [coe_map_ring_hom, map_C, set.mem_univ, subsemiring.coe_top, eq_self_iff_true,
    and_self]
end

/-- The polynomial `X` lifts. -/
lemma X_mem_lifts (f : R →+* S) : (X : S[X]) ∈ lifts f :=
⟨X, by simp only [coe_map_ring_hom, set.mem_univ, subsemiring.coe_top, eq_self_iff_true, map_X,
  and_self]⟩

/-- The polynomial `X ^ n` lifts. -/
lemma X_pow_mem_lifts (f : R →+* S) (n : ℕ) : (X ^ n : S[X]) ∈ lifts f :=
⟨X ^ n, by simp only [coe_map_ring_hom, map_pow, set.mem_univ, subsemiring.coe_top,
  eq_self_iff_true, map_X, and_self]⟩

/-- If `p` lifts and `(r : R)` then `r * p` lifts. -/
lemma base_mul_mem_lifts {p : S[X]} (r : R) (hp : p ∈ lifts f) : C (f r) * p ∈ lifts f :=
begin
  simp only [lifts, ring_hom.mem_srange] at hp ⊢,
  obtain ⟨p₁, rfl⟩ := hp,
  use C r * p₁,
  simp only [coe_map_ring_hom, map_C, map_mul]
end

/-- If `(s : S)` is in the image of `f`, then `monomial n s` lifts. -/
lemma monomial_mem_lifts {s : S} (n : ℕ) (h : s ∈ set.range f) : (monomial n s) ∈ lifts f :=
begin
  obtain ⟨r, rfl⟩ := set.mem_range.1 h,
  use monomial n r,
  simp only [coe_map_ring_hom, set.mem_univ, map_monomial, subsemiring.coe_top, eq_self_iff_true,
    and_self],
end

/-- If `p` lifts then `p.erase n` lifts. -/
lemma erase_mem_lifts {p : S[X]} (n : ℕ) (h : p ∈ lifts f) : p.erase n ∈ lifts f :=
begin
  rw [lifts_iff_ring_hom_srange, mem_map_srange] at h ⊢,
  intros k,
  by_cases hk : k = n,
  { use 0,
    simp only [hk, ring_hom.map_zero, erase_same] },
  obtain ⟨i, hi⟩ := h k,
  use i,
  simp only [hi, hk, erase_ne, ne.def, not_false_iff],
end

section lift_deg

lemma monomial_mem_lifts_and_degree_eq {s : S} {n : ℕ} (hl : monomial n s ∈ lifts f) :
  ∃ (q : R[X]), map f q = (monomial n s) ∧ q.degree = (monomial n s).degree :=
begin
  by_cases hzero : s = 0,
  { use 0,
    simp only [hzero, degree_zero, eq_self_iff_true, and_self, monomial_zero_right,
               polynomial.map_zero] },
  rw lifts_iff_set_range at hl,
  obtain ⟨q, hq⟩ := hl,
  replace hq := (ext_iff.1 hq) n,
  have hcoeff : f (q.coeff n) = s,
  { simp [coeff_monomial] at hq,
    exact hq },
  use (monomial n (q.coeff n)),
  split,
  { simp only [hcoeff, map_monomial] },
  have hqzero : q.coeff n ≠ 0,
  { intro habs,
    simp only [habs, ring_hom.map_zero] at hcoeff,
    exact hzero hcoeff.symm },
  repeat {rw monomial_eq_C_mul_X},
  simp only [hzero, hqzero, ne.def, not_false_iff, degree_C_mul_X_pow],
end

/-- A polynomial lifts if and only if it can be lifted to a polynomial of the same degree. -/
lemma mem_lifts_and_degree_eq {p : S[X]} (hlifts : p ∈ lifts f) :
  ∃ (q : R[X]), map f q = p ∧ q.degree = p.degree :=
begin
  generalize' hd : p.nat_degree = d,
  revert hd p,
  apply nat.strong_induction_on d,
  intros n hn p hlifts hdeg,
  by_cases erase_zero : p.erase_lead = 0,
  { rw [← erase_lead_add_monomial_nat_degree_leading_coeff p, erase_zero, zero_add, leading_coeff],
    exact monomial_mem_lifts_and_degree_eq (monomial_mem_lifts p.nat_degree
    ((lifts_iff_coeff_lifts p).1 hlifts p.nat_degree)) },
  have deg_erase := or.resolve_right (erase_lead_nat_degree_lt_or_erase_lead_eq_zero p) erase_zero,
  have pzero : p ≠ 0,
  { intro habs,
    exfalso,
    rw [habs, erase_lead_zero, eq_self_iff_true, not_true] at erase_zero,
    exact erase_zero },
  have lead_zero : p.coeff p.nat_degree ≠ 0,
  { rw [← leading_coeff, ne.def, leading_coeff_eq_zero]; exact pzero },
  obtain ⟨lead, hlead⟩ := monomial_mem_lifts_and_degree_eq (monomial_mem_lifts p.nat_degree
    ((lifts_iff_coeff_lifts p).1 hlifts p.nat_degree)),
  have deg_lead : lead.degree = p.nat_degree,
  { rw [hlead.2, monomial_eq_C_mul_X, degree_C_mul_X_pow p.nat_degree lead_zero] },
  rw hdeg at deg_erase,
  obtain ⟨erase, herase⟩ := hn p.erase_lead.nat_degree deg_erase
    (erase_mem_lifts p.nat_degree hlifts) (refl p.erase_lead.nat_degree),
  use erase + lead,
  split,
  { simp only [hlead, herase, polynomial.map_add],
    nth_rewrite 0 erase_lead_add_monomial_nat_degree_leading_coeff p },
  rw [←hdeg, erase_lead] at deg_erase,
  replace deg_erase := lt_of_le_of_lt degree_le_nat_degree (with_bot.coe_lt_coe.2 deg_erase),
  rw [← deg_lead, ← herase.2] at deg_erase,
  rw [degree_add_eq_right_of_degree_lt deg_erase, deg_lead, degree_eq_nat_degree pzero]
end

end lift_deg

section monic

/-- A monic polynomial lifts if and only if it can be lifted to a monic polynomial
of the same degree. -/
lemma lifts_and_degree_eq_and_monic [nontrivial S] {p : S[X]} (hlifts : p ∈ lifts f)
  (hp : p.monic) : ∃ (q : R[X]), map f q = p ∧ q.degree = p.degree ∧ q.monic :=
begin
  casesI subsingleton_or_nontrivial R with hR hR,
  { obtain ⟨q, hq⟩ := mem_lifts_and_degree_eq hlifts,
    exact ⟨q, hq.1, hq.2, monic_of_subsingleton _⟩ },
  have H : erase p.nat_degree p + X ^ p.nat_degree = p,
  { simpa only [hp.leading_coeff, C_1, one_mul, erase_lead] using erase_lead_add_C_mul_X_pow p },
  by_cases h0 : erase p.nat_degree p = 0,
  { rw [← H, h0, zero_add],
    refine ⟨X ^ p.nat_degree, _, _, monic_X_pow p.nat_degree⟩,
    { rw [polynomial.map_pow, map_X] },
    { rw [degree_X_pow, degree_X_pow] } },
  obtain ⟨q, hq⟩ := mem_lifts_and_degree_eq (erase_mem_lifts p.nat_degree hlifts),
  have hdeg : q.degree < (X ^ p.nat_degree).degree,
  { rw [@degree_X_pow R, hq.2, degree_eq_nat_degree h0, with_bot.coe_lt_coe],
    exact or.resolve_right (erase_lead_nat_degree_lt_or_erase_lead_eq_zero p) h0, },
  refine ⟨q + X ^ p.nat_degree, _, _, (monic_X_pow _).add_of_right hdeg⟩,
  { rw [polynomial.map_add, hq.1, polynomial.map_pow, map_X, H], },
  { rw [degree_add_eq_right_of_degree_lt hdeg, degree_X_pow, degree_eq_nat_degree hp.ne_zero] }
end

end monic

end semiring

section ring

variables {R : Type u} [ring R] {S : Type v} [ring S] (f : R →+* S)

/-- The subring of polynomials that lift. -/
def lifts_ring (f : R →+* S) : subring S[X] := ring_hom.range (map_ring_hom f)

/-- If `R` and `S` are rings, `p` is in the subring of polynomials that lift if and only if it is in
the subsemiring of polynomials that lift. -/
lemma lifts_iff_lifts_ring (p : S[X]) : p ∈ lifts f ↔ p ∈ lifts_ring f :=
by simp only [lifts, lifts_ring, ring_hom.mem_range, ring_hom.mem_srange]

end ring

section algebra

variables {R : Type u} [comm_semiring R] {S : Type v} [semiring S] [algebra R S]

/-- The map `polynomial R → S[X]` as an algebra homomorphism. -/
def map_alg (R : Type u) [comm_semiring R] (S : Type v) [semiring S] [algebra R S] :
  R[X] →ₐ[R] S[X] := @aeval _ S[X] _ _ _ (X : S[X])

/-- `map_alg` is the morphism induced by `R → S`. -/
lemma map_alg_eq_map (p : R[X]) : map_alg R S p = map (algebra_map R S) p :=
by simp only [map_alg, aeval_def, eval₂, map, algebra_map_apply, ring_hom.coe_comp]

/-- A polynomial `p` lifts if and only if it is in the image of `map_alg`. -/
lemma mem_lifts_iff_mem_alg (R : Type u) [comm_semiring R] {S : Type v} [semiring S] [algebra R S]
  (p : S[X]) :p ∈ lifts (algebra_map R S) ↔ p ∈ (alg_hom.range (@map_alg R _ S _ _)) :=
by simp only [coe_map_ring_hom, lifts, map_alg_eq_map, alg_hom.mem_range,
  ring_hom.mem_srange]

/-- If `p` lifts and `(r : R)` then `r • p` lifts. -/
lemma smul_mem_lifts {p : S[X]} (r : R) (hp : p ∈ lifts (algebra_map R S)) :
  r • p ∈ lifts (algebra_map R S) :=
by { rw mem_lifts_iff_mem_alg at hp ⊢, exact subalgebra.smul_mem (map_alg R S).range hp r }

end algebra

end polynomial


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

! This file was ported from Lean 3 source module category_theory.limits.constructions.pullbacks
! leanprover-community/mathlib commit cd7a8a184d7c5635e30083eabc4baf5589c30b7a
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.CategoryTheory.Limits.Shapes.BinaryProducts
import Mathlib.CategoryTheory.Limits.Shapes.Equalizers
import Mathlib.CategoryTheory.Limits.Shapes.Pullbacks

/-!
# Constructing pullbacks from binary products and equalizers

If a category as binary products and equalizers, then it has pullbacks.
Also, if a category has binary coproducts and coequalizers, then it has pushouts
-/

universe v u

open CategoryTheory

namespace CategoryTheory.Limits

/-- If the product `X ⨯ Y` and the equalizer of `π₁ ≫ f` and `π₂ ≫ g` exist, then the
    pullback of `f` and `g` exists: It is given by composing the equalizer with the projections. -/
theorem hasLimit_cospan_of_hasLimit_pair_of_hasLimit_parallelPair {C : Type u} [𝒞 : Category.{v} C]
    {X Y Z : C} (f : X ⟶ Z) (g : Y ⟶ Z) [HasLimit (pair X Y)]
    [HasLimit (parallelPair (prod.fst ≫ f) (prod.snd ≫ g))] : HasLimit (cospan f g) :=
  let π₁ : X ⨯ Y ⟶ X := prod.fst
  let π₂ : X ⨯ Y ⟶ Y := prod.snd
  let e := equalizer.ι (π₁ ≫ f) (π₂ ≫ g)
  HasLimit.mk
    { cone :=
        PullbackCone.mk (e ≫ π₁) (e ≫ π₂) <| by rw [Category.assoc, equalizer.condition]; simp
      isLimit :=
        PullbackCone.IsLimit.mk _ (fun s => equalizer.lift
          (prod.lift (s.π.app WalkingCospan.left) (s.π.app WalkingCospan.right)) <| by
              rw [← Category.assoc, limit.lift_π, ← Category.assoc, limit.lift_π];
                exact PullbackCone.condition _)
          (by simp) (by simp) fun s m h₁ h₂ => by
          apply equalizer.hom_ext
          apply prod.hom_ext
          · dsimp; simpa using h₁
          · simpa using h₂ }
#align category_theory.limits.has_limit_cospan_of_has_limit_pair_of_has_limit_parallel_pair CategoryTheory.Limits.hasLimit_cospan_of_hasLimit_pair_of_hasLimit_parallelPair

section

attribute [local instance] hasLimit_cospan_of_hasLimit_pair_of_hasLimit_parallelPair

/-- If a category has all binary products and all equalizers, then it also has all pullbacks.
    As usual, this is not an instance, since there may be a more direct way to construct
    pullbacks. -/

end

/-- If the coproduct `Y ⨿ Z` and the coequalizer of `f ≫ ι₁` and `g ≫ ι₂` exist, then the
    pushout of `f` and `g` exists: It is given by composing the inclusions with the coequalizer. -/
theorem hasColimit_span_of_hasColimit_pair_of_hasColimit_parallelPair {C : Type u}
    [𝒞 : Category.{v} C] {X Y Z : C} (f : X ⟶ Y) (g : X ⟶ Z) [HasColimit (pair Y Z)]
    [HasColimit (parallelPair (f ≫ coprod.inl) (g ≫ coprod.inr))] : HasColimit (span f g) :=
  let ι₁ : Y ⟶ Y ⨿ Z := coprod.inl
  let ι₂ : Z ⟶ Y ⨿ Z := coprod.inr
  let c := coequalizer.π (f ≫ ι₁) (g ≫ ι₂)
  HasColimit.mk
    { cocone :=
        PushoutCocone.mk (ι₁ ≫ c) (ι₂ ≫ c) <| by
          rw [← Category.assoc, ← Category.assoc, coequalizer.condition]
      isColimit :=
        PushoutCocone.IsColimit.mk _
          (fun s =>
            coequalizer.desc (coprod.desc (s.ι.app WalkingSpan.left) (s.ι.app WalkingSpan.right)) <|
              by
              rw [Category.assoc, colimit.ι_desc, Category.assoc, colimit.ι_desc];
                exact PushoutCocone.condition _)
          (by simp) (by simp) fun s m h₁ h₂ => by
          apply coequalizer.hom_ext
          apply coprod.hom_ext
          · simpa using h₁
          · simpa using h₂ }
#align category_theory.limits.has_colimit_span_of_has_colimit_pair_of_has_colimit_parallel_pair CategoryTheory.Limits.hasColimit_span_of_hasColimit_pair_of_hasColimit_parallelPair

section

attribute [local instance] hasColimit_span_of_hasColimit_pair_of_hasColimit_parallelPair

/-- If a category has all binary coproducts and all coequalizers, then it also has all pushouts.
    As usual, this is not an instance, since there may be a more direct way to construct
    pushouts. -/
theorem hasPushouts_of_hasBinaryCoproducts_of_hasCoequalizers (C : Type u) [Category.{v} C]
    [HasBinaryCoproducts C] [HasCoequalizers C] : HasPushouts C :=
  hasPushouts_of_hasColimit_span C
#align category_theory.limits.has_pushouts_of_has_binary_coproducts_of_has_coequalizers CategoryTheory.Limits.hasPushouts_of_hasBinaryCoproducts_of_hasCoequalizers

end

end CategoryTheory.Limits


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

! This file was ported from Lean 3 source module algebra.algebra.bilinear
! leanprover-community/mathlib commit 657df4339ae6ceada048c8a2980fb10e393143ec
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Algebra.Basic
import Mathlib.Algebra.Hom.Iterate
import Mathlib.Algebra.Hom.NonUnitalAlg
import Mathlib.LinearAlgebra.TensorProduct

/-!
# Facts about algebras involving bilinear maps and tensor products

We move a few basic statements about algebras out of `Algebra.Algebra.Basic`,
in order to avoid importing `LinearAlgebra.BilinearMap` and
`LinearAlgebra.TensorProduct` unnecessarily.
-/

open TensorProduct

open Module

namespace LinearMap

section NonUnitalNonAssoc

variable (R A : Type _) [CommSemiring R] [NonUnitalNonAssocSemiring A] [Module R A]
  [SMulCommClass R A A] [IsScalarTower R A A]

/-- The multiplication in a non-unital non-associative algebra is a bilinear map.

A weaker version of this for semirings exists as `AddMonoidHom.mul`. -/
def mul : A →ₗ[R] A →ₗ[R] A :=
  LinearMap.mk₂ R (· * ·) add_mul smul_mul_assoc mul_add mul_smul_comm
#align linear_map.mul LinearMap.mul

/-- The multiplication map on a non-unital algebra, as an `R`-linear map from `A ⊗[R] A` to `A`. -/
def mul' : A ⊗[R] A →ₗ[R] A :=
  TensorProduct.lift (mul R A)
#align linear_map.mul' LinearMap.mul'

variable {A}

/-- The multiplication on the left in a non-unital algebra is a linear map. -/
def mulLeft (a : A) : A →ₗ[R] A :=
  mul R A a
#align linear_map.mul_left LinearMap.mulLeft

/-- The multiplication on the right in an algebra is a linear map. -/
def mulRight (a : A) : A →ₗ[R] A :=
  (mul R A).flip a
#align linear_map.mul_right LinearMap.mulRight

/-- Simultaneous multiplication on the left and right is a linear map. -/
def mulLeftRight (ab : A × A) : A →ₗ[R] A :=
  (mulRight R ab.snd).comp (mulLeft R ab.fst)
#align linear_map.mul_left_right LinearMap.mulLeftRight

@[simp]
theorem mulLeft_toAddMonoid_hom (a : A) : (mulLeft R a : A →+ A) = AddMonoidHom.mulLeft a :=
  rfl
#align linear_map.mul_left_to_add_monoid_hom LinearMap.mulLeft_toAddMonoid_hom

@[simp]
theorem mulRight_toAddMonoid_hom (a : A) : (mulRight R a : A →+ A) = AddMonoidHom.mulRight a :=
  rfl
#align linear_map.mul_right_to_add_monoid_hom LinearMap.mulRight_toAddMonoid_hom

variable {R}

@[simp]
theorem mul_apply' (a b : A) : mul R A a b = a * b :=
  rfl
#align linear_map.mul_apply' LinearMap.mul_apply'

@[simp]
theorem mulLeft_apply (a b : A) : mulLeft R a b = a * b :=
  rfl
#align linear_map.mul_left_apply LinearMap.mulLeft_apply

@[simp]
theorem mulRight_apply (a b : A) : mulRight R a b = b * a :=
  rfl
#align linear_map.mul_right_apply LinearMap.mulRight_apply

@[simp]
theorem mulLeftRight_apply (a b x : A) : mulLeftRight R (a, b) x = a * x * b :=
  rfl
#align linear_map.mul_left_right_apply LinearMap.mulLeftRight_apply

@[simp]
theorem mul'_apply {a b : A} : mul' R A (a ⊗ₜ b) = a * b :=
  rfl
#align linear_map.mul'_apply LinearMap.mul'_apply

@[simp]
theorem mulLeft_zero_eq_zero : mulLeft R (0 : A) = 0 :=
  (mul R A).map_zero
#align linear_map.mul_left_zero_eq_zero LinearMap.mulLeft_zero_eq_zero

@[simp]
theorem mulRight_zero_eq_zero : mulRight R (0 : A) = 0 :=
  (mul R A).flip.map_zero
#align linear_map.mul_right_zero_eq_zero LinearMap.mulRight_zero_eq_zero

end NonUnitalNonAssoc

section NonUnital

variable (R A : Type _) [CommSemiring R] [NonUnitalSemiring A] [Module R A] [SMulCommClass R A A]
  [IsScalarTower R A A]

/-- The multiplication in a non-unital algebra is a bilinear map.

A weaker version of this for non-unital non-associative algebras exists as `LinearMap.mul`. -/
def NonUnitalAlgHom.lmul : A →ₙₐ[R] End R A :=
  { mul R A with
    map_mul' := by
      intro a b
      ext c
      exact mul_assoc a b c
    map_zero' := by
      ext a
      exact zero_mul a }
#align non_unital_alg_hom.lmul LinearMap.NonUnitalAlgHom.lmul

variable {R A}

@[simp]
theorem NonUnitalAlgHom.coe_lmul_eq_mul : ⇑(NonUnitalAlgHom.lmul R A) = mul R A :=
  rfl
#align non_unital_alg_hom.coe_lmul_eq_mul LinearMap.NonUnitalAlgHom.coe_lmul_eq_mul

theorem commute_mulLeft_right (a b : A) : Commute (mulLeft R a) (mulRight R b) := by
  ext c
  exact (mul_assoc a c b).symm
#align linear_map.commute_mul_left_right LinearMap.commute_mulLeft_right

@[simp]
theorem mulLeft_mul (a b : A) : mulLeft R (a * b) = (mulLeft R a).comp (mulLeft R b) := by
  ext
  simp only [mulLeft_apply, comp_apply, mul_assoc]
#align linear_map.mul_left_mul LinearMap.mulLeft_mul

@[simp]
theorem mulRight_mul (a b : A) : mulRight R (a * b) = (mulRight R b).comp (mulRight R a) := by
  ext
  simp only [mulRight_apply, comp_apply, mul_assoc]
#align linear_map.mul_right_mul LinearMap.mulRight_mul

end NonUnital

section Semiring

variable (R A : Type _) [CommSemiring R] [Semiring A] [Algebra R A]

/-- The multiplication in an algebra is an algebra homomorphism into the endomorphisms on
the algebra.

A weaker version of this for non-unital algebras exists as `NonUnitalAlgHom.mul`. -/
def Algebra.lmul : A →ₐ[R] End R A :=
  { LinearMap.mul R
      A with
    map_one' := by
      ext a
      exact one_mul a
    map_mul' := by
      intro a b
      ext c
      exact mul_assoc a b c
    map_zero' := by
      ext a
      exact zero_mul a
    commutes' := by
      intro r
      ext a
      exact (Algebra.smul_def r a).symm }
#align algebra.lmul LinearMap.Algebra.lmul

variable {R A}

@[simp]
theorem Algebra.coe_lmul_eq_mul : ⇑(Algebra.lmul R A) = mul R A :=
  rfl
#align algebra.coe_lmul_eq_mul LinearMap.Algebra.coe_lmul_eq_mul

@[simp]
theorem mulLeft_eq_zero_iff (a : A) : mulLeft R a = 0 ↔ a = 0 := by
  constructor <;> intro h
  -- porting note: had to supply `R` explicitly in `@mulLeft_apply` below
  · rw [← mul_one a, ← @mulLeft_apply R _ _ _ _ _ _ a 1, h, LinearMap.zero_apply]
  · rw [h]
    exact mulLeft_zero_eq_zero
#align linear_map.mul_left_eq_zero_iff LinearMap.mulLeft_eq_zero_iff

@[simp]
theorem mulRight_eq_zero_iff (a : A) : mulRight R a = 0 ↔ a = 0 := by
  constructor <;> intro h
  -- porting note: had to supply `R` explicitly in `@mulRight_apply` below
  · rw [← one_mul a, ← @mulRight_apply R _ _ _ _ _ _ a 1, h, LinearMap.zero_apply]
  · rw [h]
    exact mulRight_zero_eq_zero
#align linear_map.mul_right_eq_zero_iff LinearMap.mulRight_eq_zero_iff

@[simp]
theorem mulLeft_one : mulLeft R (1 : A) = LinearMap.id := by
  ext
  simp only [LinearMap.id_coe, one_mul, id.def, mulLeft_apply]
#align linear_map.mul_left_one LinearMap.mulLeft_one

@[simp]
theorem mulRight_one : mulRight R (1 : A) = LinearMap.id := by
  ext
  simp only [LinearMap.id_coe, mul_one, id.def, mulRight_apply]
#align linear_map.mul_right_one LinearMap.mulRight_one

@[simp]
theorem pow_mulLeft (a : A) (n : ℕ) : mulLeft R a ^ n = mulLeft R (a ^ n) := by
  simpa only [mulLeft, ← Algebra.coe_lmul_eq_mul] using ((Algebra.lmul R A).map_pow a n).symm
#align linear_map.pow_mul_left LinearMap.pow_mulLeft

@[simp]
theorem pow_mulRight (a : A) (n : ℕ) : mulRight R a ^ n = mulRight R (a ^ n) := by
  simp only [mulRight, ← Algebra.coe_lmul_eq_mul]
  exact
    LinearMap.coe_injective (((mulRight R a).coe_pow n).symm ▸ mul_right_iterate a n)
#align linear_map.pow_mul_right LinearMap.pow_mulRight

end Semiring

section Ring

variable {R A : Type _} [CommSemiring R] [Ring A] [Algebra R A]

/-- This instance should not be necessary. porting note: drop after lean4#2074 resolved? -/
local instance : Module R A := Algebra.toModule

/-- This instance should not be necessary. porting note: drop after lean4#2074 resolved? -/
local instance : Module A A := Semiring.toModule

theorem mulLeft_injective [NoZeroDivisors A] {x : A} (hx : x ≠ 0) :
    Function.Injective (mulLeft R x) := by
  letI : Nontrivial A := ⟨⟨x, 0, hx⟩⟩
  letI := NoZeroDivisors.to_isDomain A
  exact mul_right_injective₀ hx
#align linear_map.mul_left_injective LinearMap.mulLeft_injective

theorem mulRight_injective [NoZeroDivisors A] {x : A} (hx : x ≠ 0) :
    Function.Injective (mulRight R x) := by
  letI : Nontrivial A := ⟨⟨x, 0, hx⟩⟩
  letI := NoZeroDivisors.to_isDomain A
  exact mul_left_injective₀ hx
#align linear_map.mul_right_injective LinearMap.mulRight_injective

theorem mul_injective [NoZeroDivisors A] {x : A} (hx : x ≠ 0) : Function.Injective (mul R A x) := by
  letI : Nontrivial A := ⟨⟨x, 0, hx⟩⟩
  letI := NoZeroDivisors.to_isDomain A
  exact mul_right_injective₀ hx
#align linear_map.mul_injective LinearMap.mul_injective

end Ring

end LinearMap


/-
Copyright (c) 2018 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau, Chris Hughes, Mario Carneiro
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.associated
import Mathlib.linear_algebra.basic
import Mathlib.order.zorn
import Mathlib.order.atoms
import Mathlib.PostPort

universes u u_1 v w l u_2 u_3

namespace Mathlib

/-!

# Ideals over a ring

This file defines `ideal R`, the type of ideals over a commutative ring `R`.

## Implementation notes

`ideal R` is implemented using `submodule R R`, where `•` is interpreted as `*`.

## TODO

Support one-sided ideals, and ideals over non-commutative rings.

See `algebra.ring_quot` for quotients of non-commutative rings.
-/

/-- An ideal in a commutative semiring `R` is an additive submonoid `s` such that
`a * b ∈ s` whenever `b ∈ s`. If `R` is a ring, then `s` is an additive subgroup.  -/
def ideal (R : Type u) [comm_semiring R] :=
  submodule R R

namespace ideal

protected theorem zero_mem {α : Type u} [comm_ring α] (I : ideal α) : 0 ∈ I :=
  submodule.zero_mem I

protected theorem add_mem {α : Type u} [comm_ring α] (I : ideal α) {a : α} {b : α} : a ∈ I → b ∈ I → a + b ∈ I :=
  submodule.add_mem I

theorem neg_mem_iff {α : Type u} [comm_ring α] (I : ideal α) {a : α} : -a ∈ I ↔ a ∈ I :=
  submodule.neg_mem_iff I

theorem add_mem_iff_left {α : Type u} [comm_ring α] (I : ideal α) {a : α} {b : α} : b ∈ I → (a + b ∈ I ↔ a ∈ I) :=
  submodule.add_mem_iff_left I

theorem add_mem_iff_right {α : Type u} [comm_ring α] (I : ideal α) {a : α} {b : α} : a ∈ I → (a + b ∈ I ↔ b ∈ I) :=
  submodule.add_mem_iff_right I

protected theorem sub_mem {α : Type u} [comm_ring α] (I : ideal α) {a : α} {b : α} : a ∈ I → b ∈ I → a - b ∈ I :=
  submodule.sub_mem I

theorem mul_mem_left {α : Type u} [comm_ring α] (I : ideal α) (a : α) {b : α} : b ∈ I → a * b ∈ I :=
  submodule.smul_mem I a

theorem mul_mem_right {α : Type u} [comm_ring α] (I : ideal α) {a : α} (b : α) (h : a ∈ I) : a * b ∈ I :=
  mul_comm b a ▸ mul_mem_left I b h

end ideal

-- A separate namespace definition is needed because the variables were historically in a different order

namespace ideal

theorem ext {α : Type u} [comm_ring α] {I : ideal α} {J : ideal α} (h : ∀ (x : α), x ∈ I ↔ x ∈ J) : I = J :=
  submodule.ext h

theorem eq_top_of_unit_mem {α : Type u} [comm_ring α] (I : ideal α) (x : α) (y : α) (hx : x ∈ I) (h : y * x = 1) : I = ⊤ := sorry

theorem eq_top_of_is_unit_mem {α : Type u} [comm_ring α] (I : ideal α) {x : α} (hx : x ∈ I) (h : is_unit x) : I = ⊤ :=
  (fun (_a : ∃ (b : α), b * x = 1) =>
      Exists.dcases_on _a fun (w : α) (h_1 : w * x = 1) => idRhs (I = ⊤) (eq_top_of_unit_mem I x w hx h_1))
    (iff.mp is_unit_iff_exists_inv' h)

theorem eq_top_iff_one {α : Type u} [comm_ring α] (I : ideal α) : I = ⊤ ↔ 1 ∈ I := sorry

theorem ne_top_iff_one {α : Type u} [comm_ring α] (I : ideal α) : I ≠ ⊤ ↔ ¬1 ∈ I :=
  not_congr (eq_top_iff_one I)

theorem exists_mem_ne_zero_iff_ne_bot {α : Type u} [comm_ring α] (I : ideal α) : (∃ (p : α), ∃ (H : p ∈ I), p ≠ 0) ↔ I ≠ ⊥ := sorry

theorem exists_mem_ne_zero_of_ne_bot {α : Type u} [comm_ring α] (I : ideal α) (hI : I ≠ ⊥) : ∃ (p : α), ∃ (H : p ∈ I), p ≠ 0 :=
  iff.mpr (exists_mem_ne_zero_iff_ne_bot I) hI

@[simp] theorem unit_mul_mem_iff_mem {α : Type u} [comm_ring α] (I : ideal α) {x : α} {y : α} (hy : is_unit y) : y * x ∈ I ↔ x ∈ I := sorry

@[simp] theorem mul_unit_mem_iff_mem {α : Type u} [comm_ring α] (I : ideal α) {x : α} {y : α} (hy : is_unit y) : x * y ∈ I ↔ x ∈ I :=
  mul_comm y x ▸ unit_mul_mem_iff_mem I hy

/-- The ideal generated by a subset of a ring -/
def span {α : Type u} [comm_ring α] (s : set α) : ideal α :=
  submodule.span α s

theorem subset_span {α : Type u} [comm_ring α] {s : set α} : s ⊆ ↑(span s) :=
  submodule.subset_span

theorem span_le {α : Type u} [comm_ring α] {s : set α} {I : ideal α} : span s ≤ I ↔ s ⊆ ↑I :=
  submodule.span_le

theorem span_mono {α : Type u} [comm_ring α] {s : set α} {t : set α} : s ⊆ t → span s ≤ span t :=
  submodule.span_mono

@[simp] theorem span_eq {α : Type u} [comm_ring α] (I : ideal α) : span ↑I = I :=
  submodule.span_eq I

@[simp] theorem span_singleton_one {α : Type u} [comm_ring α] : span 1 = ⊤ :=
  iff.mpr (eq_top_iff_one (span 1)) (subset_span (set.mem_singleton 1))

theorem mem_span_insert {α : Type u} [comm_ring α] {s : set α} {x : α} {y : α} : x ∈ span (insert y s) ↔ ∃ (a : α), ∃ (z : α), ∃ (H : z ∈ span s), x = a * y + z :=
  submodule.mem_span_insert

theorem mem_span_insert' {α : Type u} [comm_ring α] {s : set α} {x : α} {y : α} : x ∈ span (insert y s) ↔ ∃ (a : α), x + a * y ∈ span s :=
  submodule.mem_span_insert'

theorem mem_span_singleton' {α : Type u} [comm_ring α] {x : α} {y : α} : x ∈ span (singleton y) ↔ ∃ (a : α), a * y = x :=
  submodule.mem_span_singleton

theorem mem_span_singleton {α : Type u} [comm_ring α] {x : α} {y : α} : x ∈ span (singleton y) ↔ y ∣ x := sorry

theorem span_singleton_le_span_singleton {α : Type u} [comm_ring α] {x : α} {y : α} : span (singleton x) ≤ span (singleton y) ↔ y ∣ x :=
  iff.trans span_le (iff.trans set.singleton_subset_iff mem_span_singleton)

theorem span_singleton_eq_span_singleton {α : Type u} [integral_domain α] {x : α} {y : α} : span (singleton x) = span (singleton y) ↔ associated x y := sorry

theorem span_eq_bot {α : Type u} [comm_ring α] {s : set α} : span s = ⊥ ↔ ∀ (x : α), x ∈ s → x = 0 :=
  submodule.span_eq_bot

@[simp] theorem span_singleton_eq_bot {α : Type u} [comm_ring α] {x : α} : span (singleton x) = ⊥ ↔ x = 0 :=
  submodule.span_singleton_eq_bot

@[simp] theorem span_zero {α : Type u} [comm_ring α] : span 0 = ⊥ :=
  eq.mpr (id (Eq._oldrec (Eq.refl (span 0 = ⊥)) (Eq.symm set.singleton_zero)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (span (singleton 0) = ⊥)) (propext span_singleton_eq_bot))) (Eq.refl 0))

theorem span_singleton_eq_top {α : Type u} [comm_ring α] {x : α} : span (singleton x) = ⊤ ↔ is_unit x := sorry

theorem span_singleton_mul_right_unit {α : Type u} [comm_ring α] {a : α} (h2 : is_unit a) (x : α) : span (singleton (x * a)) = span (singleton x) := sorry

theorem span_singleton_mul_left_unit {α : Type u} [comm_ring α] {a : α} (h2 : is_unit a) (x : α) : span (singleton (a * x)) = span (singleton x) := sorry

/--
The ideal generated by an arbitrary binary relation.
-/
def of_rel {α : Type u} [comm_ring α] (r : α → α → Prop) : ideal α :=
  submodule.span α (set_of fun (x : α) => ∃ (a : α), ∃ (b : α), ∃ (h : r a b), x = a - b)

/-- An ideal `P` of a ring `R` is prime if `P ≠ R` and `xy ∈ P → x ∈ P ∨ y ∈ P` -/
def is_prime {α : Type u} [comm_ring α] (I : ideal α) :=
  I ≠ ⊤ ∧ ∀ {x y : α}, x * y ∈ I → x ∈ I ∨ y ∈ I

theorem is_prime.mem_or_mem {α : Type u} [comm_ring α] {I : ideal α} (hI : is_prime I) {x : α} {y : α} : x * y ∈ I → x ∈ I ∨ y ∈ I :=
  and.right hI

theorem is_prime.mem_or_mem_of_mul_eq_zero {α : Type u} [comm_ring α] {I : ideal α} (hI : is_prime I) {x : α} {y : α} (h : x * y = 0) : x ∈ I ∨ y ∈ I :=
  and.right hI x y (Eq.symm h ▸ ideal.zero_mem I)

theorem is_prime.mem_of_pow_mem {α : Type u} [comm_ring α] {I : ideal α} (hI : is_prime I) {r : α} (n : ℕ) (H : r ^ n ∈ I) : r ∈ I :=
  Nat.rec (fun (H : r ^ 0 ∈ I) => not.elim (mt (iff.mpr (eq_top_iff_one I)) (and.left hI)) H)
    (fun (n : ℕ) (ih : r ^ n ∈ I → r ∈ I) (H : r ^ Nat.succ n ∈ I) => or.cases_on (is_prime.mem_or_mem hI H) id ih) n H

theorem not_is_prime_iff {α : Type u} [comm_ring α] {I : ideal α} : ¬is_prime I ↔ I = ⊤ ∨ ∃ (x : α), ∃ (H : ¬x ∈ I), ∃ (y : α), ∃ (H : ¬y ∈ I), x * y ∈ I := sorry

theorem zero_ne_one_of_proper {α : Type u} [comm_ring α] {I : ideal α} (h : I ≠ ⊤) : 0 ≠ 1 :=
  fun (hz : 0 = 1) => iff.mp (ne_top_iff_one I) h (hz ▸ ideal.zero_mem I)

theorem span_singleton_prime {α : Type u} [comm_ring α] {p : α} (hp : p ≠ 0) : is_prime (span (singleton p)) ↔ prime p := sorry

theorem bot_prime {R : Type u_1} [integral_domain R] : is_prime ⊥ := sorry

/-- An ideal is maximal if it is maximal in the collection of proper ideals. -/
def is_maximal {α : Type u} [comm_ring α] (I : ideal α) :=
  is_coatom I

theorem is_maximal_iff {α : Type u} [comm_ring α] {I : ideal α} : is_maximal I ↔ ¬1 ∈ I ∧ ∀ (J : ideal α) (x : α), I ≤ J → ¬x ∈ I → x ∈ J → 1 ∈ J := sorry

theorem is_maximal.eq_of_le {α : Type u} [comm_ring α] {I : ideal α} {J : ideal α} (hI : is_maximal I) (hJ : J ≠ ⊤) (IJ : I ≤ J) : I = J :=
  iff.mpr eq_iff_le_not_lt { left := IJ, right := fun (h : I < J) => hJ (and.right hI J h) }

theorem is_maximal.exists_inv {α : Type u} [comm_ring α] {I : ideal α} (hI : is_maximal I) {x : α} (hx : ¬x ∈ I) : ∃ (y : α), y * x - 1 ∈ I := sorry

theorem is_maximal.is_prime {α : Type u} [comm_ring α] {I : ideal α} (H : is_maximal I) : is_prime I := sorry

protected instance is_maximal.is_prime' {α : Type u} [comm_ring α] (I : ideal α) [H : is_maximal I] : is_prime I :=
  is_maximal.is_prime

/-- Krull's theorem: if `I` is an ideal that is not the whole ring, then it is included in some
    maximal ideal. -/
theorem exists_le_maximal {α : Type u} [comm_ring α] (I : ideal α) (hI : I ≠ ⊤) : ∃ (M : ideal α), is_maximal M ∧ I ≤ M := sorry

/-- Krull's theorem: a nontrivial ring has a maximal ideal. -/
theorem exists_maximal {α : Type u} [comm_ring α] [nontrivial α] : ∃ (M : ideal α), is_maximal M := sorry

/-- If P is not properly contained in any maximal ideal then it is not properly contained
  in any proper ideal -/
theorem maximal_of_no_maximal {R : Type u} [comm_ring R] {P : ideal R} (hmax : ∀ (m : ideal R), P < m → ¬is_maximal m) (J : ideal R) (hPJ : P < J) : J = ⊤ := sorry

theorem mem_span_pair {α : Type u} [comm_ring α] {x : α} {y : α} {z : α} : z ∈ span (insert x (singleton y)) ↔ ∃ (a : α), ∃ (b : α), a * x + b * y = z := sorry

theorem span_singleton_lt_span_singleton {β : Type v} [integral_domain β] {x : β} {y : β} : span (singleton x) < span (singleton y) ↔ dvd_not_unit y x := sorry

theorem factors_decreasing {β : Type v} [integral_domain β] (b₁ : β) (b₂ : β) (h₁ : b₁ ≠ 0) (h₂ : ¬is_unit b₂) : span (singleton (b₁ * b₂)) < span (singleton b₁) := sorry

/-- The quotient `R/I` of a ring `R` by an ideal `I`. -/
def quotient {α : Type u} [comm_ring α] (I : ideal α) :=
  submodule.quotient I

namespace quotient

protected instance has_one {α : Type u} [comm_ring α] (I : ideal α) : HasOne (quotient I) :=
  { one := submodule.quotient.mk 1 }

protected instance has_mul {α : Type u} [comm_ring α] (I : ideal α) : Mul (quotient I) :=
  { mul := fun (a b : quotient I) => quotient.lift_on₂' a b (fun (a b : α) => submodule.quotient.mk (a * b)) sorry }

protected instance comm_ring {α : Type u} [comm_ring α] (I : ideal α) : comm_ring (quotient I) :=
  comm_ring.mk add_comm_group.add sorry add_comm_group.zero sorry sorry add_comm_group.neg add_comm_group.sub sorry sorry
    Mul.mul sorry 1 sorry sorry sorry sorry sorry

/-- The ring homomorphism from a ring `R` to a quotient ring `R/I`. -/
def mk {α : Type u} [comm_ring α] (I : ideal α) : α →+* quotient I :=
  ring_hom.mk (fun (a : α) => submodule.quotient.mk a) sorry sorry sorry sorry

protected instance inhabited {α : Type u} [comm_ring α] {I : ideal α} : Inhabited (quotient I) :=
  { default := coe_fn (mk I) (bit1 (bit0 (bit1 (bit0 (bit0 1))))) }

protected theorem eq {α : Type u} [comm_ring α] {I : ideal α} {x : α} {y : α} : coe_fn (mk I) x = coe_fn (mk I) y ↔ x - y ∈ I :=
  submodule.quotient.eq I

@[simp] theorem mk_eq_mk {α : Type u} [comm_ring α] {I : ideal α} (x : α) : submodule.quotient.mk x = coe_fn (mk I) x :=
  rfl

theorem eq_zero_iff_mem {α : Type u} {a : α} [comm_ring α] {I : ideal α} : coe_fn (mk I) a = 0 ↔ a ∈ I := sorry

theorem zero_eq_one_iff {α : Type u} [comm_ring α] {I : ideal α} : 0 = 1 ↔ I = ⊤ :=
  iff.trans eq_comm (iff.trans eq_zero_iff_mem (iff.symm (eq_top_iff_one I)))

theorem zero_ne_one_iff {α : Type u} [comm_ring α] {I : ideal α} : 0 ≠ 1 ↔ I ≠ ⊤ :=
  not_congr zero_eq_one_iff

protected theorem nontrivial {α : Type u} [comm_ring α] {I : ideal α} (hI : I ≠ ⊤) : nontrivial (quotient I) :=
  nontrivial.mk (Exists.intro 0 (Exists.intro 1 (iff.mpr zero_ne_one_iff hI)))

theorem mk_surjective {α : Type u} [comm_ring α] {I : ideal α} : function.surjective ⇑(mk I) :=
  fun (y : quotient I) => quotient.induction_on' y fun (x : α) => exists.intro x rfl

protected instance integral_domain {α : Type u} [comm_ring α] (I : ideal α) [hI : is_prime I] : integral_domain (quotient I) :=
  integral_domain.mk comm_ring.add sorry comm_ring.zero sorry sorry comm_ring.neg comm_ring.sub sorry sorry comm_ring.mul
    sorry comm_ring.one sorry sorry sorry sorry sorry sorry sorry

theorem is_integral_domain_iff_prime {α : Type u} [comm_ring α] (I : ideal α) : is_integral_domain (quotient I) ↔ is_prime I := sorry

theorem exists_inv {α : Type u} [comm_ring α] {I : ideal α} [hI : is_maximal I] {a : quotient I} : a ≠ 0 → ∃ (b : quotient I), a * b = 1 := sorry

/-- quotient by maximal ideal is a field. def rather than instance, since users will have
computable inverses in some applications -/
protected def field {α : Type u} [comm_ring α] (I : ideal α) [hI : is_maximal I] : field (quotient I) :=
  field.mk integral_domain.add sorry integral_domain.zero sorry sorry integral_domain.neg integral_domain.sub sorry sorry
    integral_domain.mul sorry integral_domain.one sorry sorry sorry sorry sorry
    (fun (a : quotient I) => dite (a = 0) (fun (ha : a = 0) => 0) fun (ha : ¬a = 0) => classical.some (exists_inv ha))
    sorry sorry sorry

/-- If the quotient by an ideal is a field, then the ideal is maximal. -/
theorem maximal_of_is_field {α : Type u} [comm_ring α] (I : ideal α) (hqf : is_field (quotient I)) : is_maximal I := sorry

/-- The quotient of a ring by an ideal is a field iff the ideal is maximal. -/
theorem maximal_ideal_iff_is_field_quotient {α : Type u} [comm_ring α] (I : ideal α) : is_maximal I ↔ is_field (quotient I) :=
  { mp := fun (h : is_maximal I) => field.to_is_field (quotient I),
    mpr := fun (h : is_field (quotient I)) => maximal_of_is_field I h }

/-- Given a ring homomorphism `f : α →+* β` sending all elements of an ideal to zero,
lift it to the quotient by this ideal. -/
def lift {α : Type u} {β : Type v} [comm_ring α] [comm_ring β] (S : ideal α) (f : α →+* β) (H : ∀ (a : α), a ∈ S → coe_fn f a = 0) : quotient S →+* β :=
  ring_hom.mk (fun (x : quotient S) => quotient.lift_on' x ⇑f sorry) sorry sorry sorry sorry

@[simp] theorem lift_mk {α : Type u} {β : Type v} {a : α} [comm_ring α] [comm_ring β] (S : ideal α) (f : α →+* β) (H : ∀ (a : α), a ∈ S → coe_fn f a = 0) : coe_fn (lift S f H) (coe_fn (mk S) a) = coe_fn f a :=
  rfl

@[simp] theorem lift_comp_mk {α : Type u} {β : Type v} [comm_ring α] [comm_ring β] (S : ideal α) (f : α →+* β) (H : ∀ (a : α), a ∈ S → coe_fn f a = 0) : ring_hom.comp (lift S f H) (mk S) = f :=
  ring_hom.ext fun (_x : α) => rfl

theorem lift_surjective {α : Type u} {β : Type v} [comm_ring α] [comm_ring β] (S : ideal α) (f : α →+* β) (H : ∀ (a : α), a ∈ S → coe_fn f a = 0) (hf : function.surjective ⇑f) : function.surjective ⇑(lift S f H) := sorry

end quotient

theorem mem_sup_left {R : Type u} [comm_ring R] {S : ideal R} {T : ideal R} {x : R} : x ∈ S → x ∈ S ⊔ T :=
  (fun (this : S ≤ S ⊔ T) => this) le_sup_left

theorem mem_sup_right {R : Type u} [comm_ring R] {S : ideal R} {T : ideal R} {x : R} : x ∈ T → x ∈ S ⊔ T :=
  (fun (this : T ≤ S ⊔ T) => this) le_sup_right

theorem mem_supr_of_mem {R : Type u} [comm_ring R] {ι : Type u_1} {S : ι → ideal R} (i : ι) {x : R} : x ∈ S i → x ∈ supr S :=
  (fun (this : S i ≤ supr S) => this) (le_supr S i)

theorem mem_Sup_of_mem {R : Type u} [comm_ring R] {S : set (ideal R)} {s : ideal R} (hs : s ∈ S) {x : R} : x ∈ s → x ∈ Sup S :=
  (fun (this : s ≤ Sup S) => this) (le_Sup hs)

theorem mem_Inf {R : Type u} [comm_ring R] {s : set (ideal R)} {x : R} : x ∈ Inf s ↔ ∀ {I : ideal R}, I ∈ s → x ∈ I := sorry

@[simp] theorem mem_inf {R : Type u} [comm_ring R] {I : ideal R} {J : ideal R} {x : R} : x ∈ I ⊓ J ↔ x ∈ I ∧ x ∈ J :=
  iff.rfl

@[simp] theorem mem_infi {R : Type u} [comm_ring R] {ι : Type u_1} {I : ι → ideal R} {x : R} : x ∈ infi I ↔ ∀ (i : ι), x ∈ I i :=
  submodule.mem_infi fun (i : ι) => I i

@[simp] theorem mem_bot {R : Type u} [comm_ring R] {x : R} : x ∈ ⊥ ↔ x = 0 :=
  submodule.mem_bot R

/-- All ideals in a field are trivial. -/
theorem eq_bot_or_top {K : Type u} [field K] (I : ideal K) : I = ⊥ ∨ I = ⊤ := sorry

theorem eq_bot_of_prime {K : Type u} [field K] (I : ideal K) [h : is_prime I] : I = ⊥ :=
  iff.mp or_iff_not_imp_right (eq_bot_or_top I) (and.left h)

theorem bot_is_maximal {K : Type u} [field K] : is_maximal ⊥ := sorry

/-- `I^n` as an ideal of `R^n`. -/
def pi {α : Type u} [comm_ring α] (I : ideal α) (ι : Type v) : ideal (ι → α) :=
  submodule.mk (set_of fun (x : ι → α) => ∀ (i : ι), x i ∈ I) sorry sorry sorry

theorem mem_pi {α : Type u} [comm_ring α] (I : ideal α) (ι : Type v) (x : ι → α) : x ∈ pi I ι ↔ ∀ (i : ι), x i ∈ I :=
  iff.rfl

/-- `R^n/I^n` is a `R/I`-module. -/
protected instance module_pi {α : Type u} [comm_ring α] (I : ideal α) (ι : Type v) : module (quotient I) (quotient (pi I ι)) :=
  semimodule.mk sorry sorry

/-- `R^n/I^n` is isomorphic to `(R/I)^n` as an `R/I`-module. -/
def pi_quot_equiv {α : Type u} [comm_ring α] (I : ideal α) (ι : Type v) : linear_equiv (quotient I) (quotient (pi I ι)) (ι → quotient I) :=
  linear_equiv.mk
    (fun (x : quotient (pi I ι)) => quotient.lift_on' x (fun (f : ι → α) (i : ι) => coe_fn (quotient.mk I) (f i)) sorry)
    sorry sorry (fun (x : ι → quotient I) => coe_fn (quotient.mk (pi I ι)) fun (i : ι) => quotient.out' (x i)) sorry sorry

/-- If `f : R^n → R^m` is an `R`-linear map and `I ⊆ R` is an ideal, then the image of `I^n` is
    contained in `I^m`. -/
theorem map_pi {α : Type u} [comm_ring α] (I : ideal α) {ι : Type u_1} [fintype ι] {ι' : Type w} (x : ι → α) (hi : ∀ (i : ι), x i ∈ I) (f : linear_map α (ι → α) (ι' → α)) (i : ι') : coe_fn f x i ∈ I := sorry

end ideal

namespace ring

theorem not_is_field_of_subsingleton {R : Type u_1} [ring R] [subsingleton R] : ¬is_field R := sorry

theorem exists_not_is_unit_of_not_is_field {R : Type u_1} [comm_ring R] [nontrivial R] (hf : ¬is_field R) : ∃ (x : R), ∃ (H : x ≠ 0), ¬is_unit x := sorry

theorem not_is_field_iff_exists_ideal_bot_lt_and_lt_top {R : Type u_1} [comm_ring R] [nontrivial R] : ¬is_field R ↔ ∃ (I : ideal R), ⊥ < I ∧ I < ⊤ := sorry

theorem not_is_field_iff_exists_prime {R : Type u_1} [comm_ring R] [nontrivial R] : ¬is_field R ↔ ∃ (p : ideal R), p ≠ ⊥ ∧ ideal.is_prime p := sorry

/-- When a ring is not a field, the maximal ideals are nontrivial. -/
theorem ne_bot_of_is_maximal_of_not_is_field {R : Type u_1} [comm_ring R] [nontrivial R] {M : ideal R} (max : ideal.is_maximal M) (not_field : ¬is_field R) : M ≠ ⊥ := sorry

end ring

namespace ideal

/-- Maximal ideals in a non-field are nontrivial. -/
theorem bot_lt_of_maximal {R : Type u} [comm_ring R] [nontrivial R] (M : ideal R) [hm : is_maximal M] (non_field : ¬is_field R) : ⊥ < M := sorry

end ideal

/-- The set of non-invertible elements of a monoid. -/
def nonunits (α : Type u) [monoid α] : set α :=
  set_of fun (a : α) => ¬is_unit a

@[simp] theorem mem_nonunits_iff {α : Type u} {a : α} [comm_monoid α] : a ∈ nonunits α ↔ ¬is_unit a :=
  iff.rfl

theorem mul_mem_nonunits_right {α : Type u} {a : α} {b : α} [comm_monoid α] : b ∈ nonunits α → a * b ∈ nonunits α :=
  mt is_unit_of_mul_is_unit_right

theorem mul_mem_nonunits_left {α : Type u} {a : α} {b : α} [comm_monoid α] : a ∈ nonunits α → a * b ∈ nonunits α :=
  mt is_unit_of_mul_is_unit_left

theorem zero_mem_nonunits {α : Type u} [semiring α] : 0 ∈ nonunits α ↔ 0 ≠ 1 :=
  not_congr is_unit_zero_iff

@[simp] theorem one_not_mem_nonunits {α : Type u} [monoid α] : ¬1 ∈ nonunits α :=
  not_not_intro is_unit_one

theorem coe_subset_nonunits {α : Type u} [comm_ring α] {I : ideal α} (h : I ≠ ⊤) : ↑I ⊆ nonunits α :=
  fun (x : α) (hx : x ∈ ↑I) (hu : is_unit x) => h (ideal.eq_top_of_is_unit_mem I hx hu)

theorem exists_max_ideal_of_mem_nonunits {α : Type u} {a : α} [comm_ring α] (h : a ∈ nonunits α) : ∃ (I : ideal α), ideal.is_maximal I ∧ a ∈ I := sorry

/-- A commutative ring is local if it has a unique maximal ideal. Note that
  `local_ring` is a predicate. -/
class local_ring (α : Type u) [comm_ring α]
extends nontrivial α
where
  is_local : ∀ (a : α), is_unit a ∨ is_unit (1 - a)

namespace local_ring

theorem is_unit_or_is_unit_one_sub_self {α : Type u} [comm_ring α] [local_ring α] (a : α) : is_unit a ∨ is_unit (1 - a) :=
  is_local a

theorem is_unit_of_mem_nonunits_one_sub_self {α : Type u} [comm_ring α] [local_ring α] (a : α) (h : 1 - a ∈ nonunits α) : is_unit a :=
  iff.mp or_iff_not_imp_right (is_local a) h

theorem is_unit_one_sub_self_of_mem_nonunits {α : Type u} [comm_ring α] [local_ring α] (a : α) (h : a ∈ nonunits α) : is_unit (1 - a) :=
  iff.mp or_iff_not_imp_left (is_local a) h

theorem nonunits_add {α : Type u} [comm_ring α] [local_ring α] {x : α} {y : α} (hx : x ∈ nonunits α) (hy : y ∈ nonunits α) : x + y ∈ nonunits α := sorry

/-- The ideal of elements that are not units. -/
def maximal_ideal (α : Type u) [comm_ring α] [local_ring α] : ideal α :=
  submodule.mk (nonunits α) sorry sorry sorry

protected instance maximal_ideal.is_maximal (α : Type u) [comm_ring α] [local_ring α] : ideal.is_maximal (maximal_ideal α) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (ideal.is_maximal (maximal_ideal α))) (propext ideal.is_maximal_iff)))
    { left := id fun (h : 1 ∈ maximal_ideal α) => h is_unit_one,
      right :=
        fun (I : ideal α) (x : α) (hI : maximal_ideal α ≤ I) (hx : ¬x ∈ maximal_ideal α) (H : x ∈ I) =>
          Exists.dcases_on (eq.mp (Eq._oldrec (Eq.refl (¬x ∈ maximal_ideal α)) (propext not_not)) hx)
            fun (u : units α) (hx_h : ↑u = x) =>
              Eq._oldrec
                (fun (H : ↑u ∈ I) =>
                  eq.mpr (id (Eq.refl (1 ∈ I)))
                    (eq.mp
                      ((fun (ᾰ ᾰ_1 : α) (e_2 : ᾰ = ᾰ_1) (ᾰ_2 ᾰ_3 : ideal α) (e_3 : ᾰ_2 = ᾰ_3) =>
                          congr (congr_arg has_mem.mem e_2) e_3)
                        (↑(u⁻¹) * ↑u) 1 (units.inv_mul u) I I (Eq.refl I))
                      (ideal.mul_mem_left I (↑(u⁻¹)) H)))
                hx_h H }

theorem maximal_ideal_unique (α : Type u) [comm_ring α] [local_ring α] : exists_unique fun (I : ideal α) => ideal.is_maximal I := sorry

theorem eq_maximal_ideal {α : Type u} [comm_ring α] [local_ring α] {I : ideal α} (hI : ideal.is_maximal I) : I = maximal_ideal α :=
  unique_of_exists_unique (maximal_ideal_unique α) hI (maximal_ideal.is_maximal α)

theorem le_maximal_ideal {α : Type u} [comm_ring α] [local_ring α] {J : ideal α} (hJ : J ≠ ⊤) : J ≤ maximal_ideal α := sorry

@[simp] theorem mem_maximal_ideal {α : Type u} [comm_ring α] [local_ring α] (x : α) : x ∈ maximal_ideal α ↔ x ∈ nonunits α :=
  iff.rfl

end local_ring

theorem local_of_nonunits_ideal {α : Type u} [comm_ring α] (hnze : 0 ≠ 1) (h : ∀ (x y : α), x ∈ nonunits α → y ∈ nonunits α → x + y ∈ nonunits α) : local_ring α := sorry

theorem local_of_unique_max_ideal {α : Type u} [comm_ring α] (h : exists_unique fun (I : ideal α) => ideal.is_maximal I) : local_ring α := sorry

theorem local_of_unique_nonzero_prime (R : Type u) [comm_ring R] (h : exists_unique fun (P : ideal R) => P ≠ ⊥ ∧ ideal.is_prime P) : local_ring R := sorry

theorem local_of_surjective {A : Type u_1} {B : Type u_2} [comm_ring A] [local_ring A] [comm_ring B] [nontrivial B] (f : A →+* B) (hf : function.surjective ⇑f) : local_ring B := sorry

/-- A local ring homomorphism is a homomorphism between local rings
  such that the image of the maximal ideal of the source is contained within
  the maximal ideal of the target. -/
class is_local_ring_hom {α : Type u} {β : Type v} [semiring α] [semiring β] (f : α →+* β)
where
  map_nonunit : ∀ (a : α), is_unit (coe_fn f a) → is_unit a

protected instance is_local_ring_hom_id (A : Type u_1) [semiring A] : is_local_ring_hom (ring_hom.id A) :=
  is_local_ring_hom.mk fun (a : A) => id

@[simp] theorem is_unit_map_iff {A : Type u_1} {B : Type u_2} [semiring A] [semiring B] (f : A →+* B) [is_local_ring_hom f] (a : A) : is_unit (coe_fn f a) ↔ is_unit a :=
  { mp := is_local_ring_hom.map_nonunit a, mpr := ring_hom.is_unit_map f }

protected instance is_local_ring_hom_comp {A : Type u_1} {B : Type u_2} {C : Type u_3} [semiring A] [semiring B] [semiring C] (g : B →+* C) (f : A →+* B) [is_local_ring_hom g] [is_local_ring_hom f] : is_local_ring_hom (ring_hom.comp g f) :=
  is_local_ring_hom.mk fun (a : A) => is_local_ring_hom.map_nonunit a ∘ is_local_ring_hom.map_nonunit (coe_fn f a)

@[simp] theorem is_unit_of_map_unit {α : Type u} {β : Type v} [semiring α] [semiring β] (f : α →+* β) [is_local_ring_hom f] (a : α) (h : is_unit (coe_fn f a)) : is_unit a :=
  is_local_ring_hom.map_nonunit a h

theorem of_irreducible_map {α : Type u} {β : Type v} [semiring α] [semiring β] (f : α →+* β) [h : is_local_ring_hom f] {x : α} (hfx : irreducible (coe_fn f x)) : irreducible x := sorry

theorem map_nonunit {α : Type u} {β : Type v} [comm_ring α] [local_ring α] [comm_ring β] [local_ring β] (f : α →+* β) [is_local_ring_hom f] (a : α) (h : a ∈ local_ring.maximal_ideal α) : coe_fn f a ∈ local_ring.maximal_ideal β :=
  fun (H : is_unit (coe_fn f a)) => h (is_unit_of_map_unit f a H)

namespace local_ring

/-- The residue field of a local ring is the quotient of the ring by its maximal ideal. -/
def residue_field (α : Type u) [comm_ring α] [local_ring α] :=
  ideal.quotient (maximal_ideal α)

protected instance residue_field.field (α : Type u) [comm_ring α] [local_ring α] : field (residue_field α) :=
  ideal.quotient.field (maximal_ideal α)

protected instance residue_field.inhabited (α : Type u) [comm_ring α] [local_ring α] : Inhabited (residue_field α) :=
  { default := bit1 (bit0 (bit1 (bit0 (bit0 1)))) }

/-- The quotient map from a local ring to its residue field. -/
def residue (α : Type u) [comm_ring α] [local_ring α] : α →+* residue_field α :=
  ideal.quotient.mk (maximal_ideal α)

namespace residue_field

/-- The map on residue fields induced by a local homomorphism between local rings -/
def map {α : Type u} {β : Type v} [comm_ring α] [local_ring α] [comm_ring β] [local_ring β] (f : α →+* β) [is_local_ring_hom f] : residue_field α →+* residue_field β :=
  ideal.quotient.lift (maximal_ideal α) (ring_hom.comp (ideal.quotient.mk (maximal_ideal β)) f) sorry

end residue_field

end local_ring

namespace field

protected instance local_ring {α : Type u} [field α] : local_ring α :=
  local_ring.mk
    fun (a : α) =>
      dite (a = 0)
        (fun (h : a = 0) =>
          Or.inr
            (eq.mpr (id (Eq._oldrec (Eq.refl (is_unit (1 - a))) h))
              (eq.mpr (id (Eq._oldrec (Eq.refl (is_unit (1 - 0))) (sub_zero 1))) is_unit_one)))
        fun (h : ¬a = 0) => Or.inl (is_unit_of_mul_eq_one a (a⁻¹) (div_self h))


/-
Copyright (c) 2019 Zhouhang Zhou. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Zhouhang Zhou, Yury Kudryashov
-/
import measure_theory.l1_space

/-!
# Density of simple functions

Show that each Borel measurable function can be approximated,
both pointwise and in `L¹` norm, by a sequence of simple functions.

## Main definitions

* `measure_theory.simple_func.nearest_pt (e : ℕ → α) (N : ℕ) : α →ₛ ℕ`: the `simple_func` sending
  each `x : α` to the point `e k` which is the nearest to `x` among `e 0`, ..., `e N`.
* `measure_theory.simple_func.approx_on (f : β → α) (hf : measurable f) (s : set α) (y₀ : α)
  (h₀ : y₀ ∈ s) [separable_space s] (n : ℕ) : β →ₛ α` : a simple function that takes values in `s`
  and approximates `f`. If `f x ∈ s`, then `measure_theory.simple_func.approx_on f hf s y₀ h₀ n x`
  tends to `f x` as `n` tends to `∞`. If `α` is a `normed_group`, `f x - y₀`
  is `measure_theory.integrable`, and `f x ∈ s` for a.e. `x`, then
  `simple_func.approx_on f hf s y₀ h₀ n` tends to `f` in `L₁`. The main use case is `s = univ`,
  `y₀ = 0`.

## Notations

* `α →ₛ β` (local notation): the type of simple functions `α → β`.
-/

open set filter topological_space
open_locale classical topological_space ennreal
variables {α β ι E : Type*}

namespace measure_theory
open ennreal emetric

local infixr ` →ₛ `:25 := simple_func

namespace simple_func

variables [measurable_space α] [emetric_space α] [opens_measurable_space α]

/-- `nearest_pt_ind e N x` is the index `k` such that `e k` is the nearest point to `x` among the
points `e 0`, ..., `e N`. If more than one point are at the same distance from `x`, then
`nearest_pt_ind e N x` returns the least of their indexes. -/
noncomputable def nearest_pt_ind (e : ℕ → α) : ℕ → α →ₛ ℕ
| 0 := const α 0
| (N + 1) := piecewise (⋂ k ≤ N, {x | edist (e (N + 1)) x < edist (e k) x})
    (measurable_set.Inter $ λ k, measurable_set.Inter_Prop $ λ hk,
      measurable_set_lt measurable_edist_right measurable_edist_right)
    (const α $ N + 1) (nearest_pt_ind N)

/-- `nearest_pt e N x` is the nearest point to `x` among the points `e 0`, ..., `e N`. If more than
one point are at the same distance from `x`, then `nearest_pt e N x` returns the point with the
least possible index. -/
noncomputable def nearest_pt (e : ℕ → α) (N : ℕ) : α →ₛ α :=
(nearest_pt_ind e N).map e

@[simp] lemma nearest_pt_ind_zero (e : ℕ → α) : nearest_pt_ind e 0 = const α 0 := rfl

@[simp] lemma nearest_pt_zero (e : ℕ → α) : nearest_pt e 0 = const α (e 0) := rfl

lemma nearest_pt_ind_succ (e : ℕ → α) (N : ℕ) (x : α) :
  nearest_pt_ind e (N + 1) x =
    if ∀ k ≤ N, edist (e (N + 1)) x < edist (e k) x
    then N + 1 else nearest_pt_ind e N x :=
by { simp only [nearest_pt_ind, coe_piecewise, set.piecewise], congr, simp }

lemma nearest_pt_ind_le (e : ℕ → α) (N : ℕ) (x : α) : nearest_pt_ind e N x ≤ N :=
begin
  induction N with N ihN, { simp },
  simp only [nearest_pt_ind_succ],
  split_ifs,
  exacts [le_rfl, ihN.trans N.le_succ]
end

lemma edist_nearest_pt_le (e : ℕ → α) (x : α) {k N : ℕ} (hk : k ≤ N) :
  edist (nearest_pt e N x) x ≤ edist (e k) x :=
begin
  induction N with N ihN generalizing k,
  { simp [nonpos_iff_eq_zero.1 hk, le_refl] },
  { simp only [nearest_pt, nearest_pt_ind_succ, map_apply],
    split_ifs,
    { rcases hk.eq_or_lt with rfl|hk,
      exacts [le_rfl, (h k (nat.lt_succ_iff.1 hk)).le] },
    { push_neg at h,
      rcases h with ⟨l, hlN, hxl⟩,
      rcases hk.eq_or_lt with rfl|hk,
      exacts [(ihN hlN).trans hxl, ihN (nat.lt_succ_iff.1 hk)] } }
end

lemma tendsto_nearest_pt {e : ℕ → α} {x : α} (hx : x ∈ closure (range e)) :
  tendsto (λ N, nearest_pt e N x) at_top (𝓝 x) :=
begin
  refine (at_top_basis.tendsto_iff nhds_basis_eball).2 (λ ε hε, _),
  rcases emetric.mem_closure_iff.1 hx ε hε with ⟨_, ⟨N, rfl⟩, hN⟩,
  rw [edist_comm] at hN,
  exact ⟨N, trivial, λ n hn, (edist_nearest_pt_le e x hn).trans_lt hN⟩
end

variables [measurable_space β] {f : β → α}

/-- Approximate a measurable function by a sequence of simple functions `F n` such that
`F n x ∈ s`. -/
noncomputable def approx_on (f : β → α) (hf : measurable f) (s : set α) (y₀ : α) (h₀ : y₀ ∈ s)
  [separable_space s] (n : ℕ) :
  β →ₛ α :=
by haveI : nonempty s := ⟨⟨y₀, h₀⟩⟩;
  exact comp (nearest_pt (λ k, nat.cases_on k y₀ (coe ∘ dense_seq s) : ℕ → α) n) f hf

@[simp] lemma approx_on_zero {f : β → α} (hf : measurable f) {s : set α} {y₀ : α} (h₀ : y₀ ∈ s)
  [separable_space s] (x : β) :
  approx_on f hf s y₀ h₀ 0 x = y₀ :=
rfl

lemma approx_on_mem {f : β → α} (hf : measurable f) {s : set α} {y₀ : α} (h₀ : y₀ ∈ s)
  [separable_space s] (n : ℕ) (x : β) :
  approx_on f hf s y₀ h₀ n x ∈ s :=
begin
  haveI : nonempty s := ⟨⟨y₀, h₀⟩⟩,
  suffices : ∀ n, (nat.cases_on n y₀ (coe ∘ dense_seq s) : α) ∈ s, { apply this },
  rintro (_|n),
  exacts [h₀, subtype.mem _]
end

@[simp] lemma approx_on_comp {γ : Type*} [measurable_space γ] {f : β → α} (hf : measurable f)
  {g : γ → β} (hg : measurable g) {s : set α} {y₀ : α} (h₀ : y₀ ∈ s) [separable_space s] (n : ℕ) :
  approx_on (f ∘ g) (hf.comp hg) s y₀ h₀ n = (approx_on f hf s y₀ h₀ n).comp g hg :=
rfl

lemma tendsto_approx_on {f : β → α} (hf : measurable f) {s : set α} {y₀ : α} (h₀ : y₀ ∈ s)
  [separable_space s] {x : β} (hx : f x ∈ closure s) :
  tendsto (λ n, approx_on f hf s y₀ h₀ n x) at_top (𝓝 $ f x) :=
begin
  haveI : nonempty s := ⟨⟨y₀, h₀⟩⟩,
  rw [← @subtype.range_coe _ s, ← image_univ, ← (dense_range_dense_seq s).closure_eq] at hx,
  simp only [approx_on, coe_comp],
  refine tendsto_nearest_pt (closure_minimal _ is_closed_closure hx),
  simp only [nat.range_cases_on, closure_union, range_comp coe],
  exact subset.trans (image_closure_subset_closure_image continuous_subtype_coe)
    (subset_union_right _ _)
end

lemma edist_approx_on_le {f : β → α} (hf : measurable f) {s : set α} {y₀ : α} (h₀ : y₀ ∈ s)
  [separable_space s] (x : β) (n : ℕ) :
  edist (approx_on f hf s y₀ h₀ n x) (f x) ≤ edist y₀ (f x) :=
begin
  dsimp only [approx_on, coe_comp, (∘)],
  exact edist_nearest_pt_le _ _ (zero_le _)
end

lemma edist_approx_on_y0_le {f : β → α} (hf : measurable f) {s : set α} {y₀ : α} (h₀ : y₀ ∈ s)
  [separable_space s] (x : β) (n : ℕ) :
  edist y₀ (approx_on f hf s y₀ h₀ n x) ≤ edist y₀ (f x) + edist y₀ (f x) :=
calc edist y₀ (approx_on f hf s y₀ h₀ n x) ≤
  edist y₀ (f x) + edist (approx_on f hf s y₀ h₀ n x) (f x) : edist_triangle_right _ _ _
... ≤ edist y₀ (f x) + edist y₀ (f x) : add_le_add_left (edist_approx_on_le hf h₀ x n) _

variables [measurable_space E] [normed_group E]

lemma norm_approx_on_zero_le [opens_measurable_space E] {f : β → E} (hf : measurable f)
  {s : set E} (h₀ : (0 : E) ∈ s) [separable_space s] (x : β) (n : ℕ) :
  ∥approx_on f hf s 0 h₀ n x∥ ≤ ∥f x∥ + ∥f x∥ :=
begin
  have := edist_approx_on_y0_le hf h₀ x n,
  simp [edist_comm (0 : E), edist_eq_coe_nnnorm] at this,
  exact_mod_cast this,
end

lemma tendsto_approx_on_L1_edist  [opens_measurable_space E]
 {f : β → E} (hf : measurable f) {s : set E} {y₀ : E} (h₀ : y₀ ∈ s) [separable_space s]
  {μ : measure β} (hμ : ∀ᵐ x ∂μ, f x ∈ closure s) (hi : has_finite_integral (λ x, f x - y₀) μ) :
  tendsto (λ n, ∫⁻ x, edist (approx_on f hf s y₀ h₀ n x) (f x) ∂μ) at_top (𝓝 0) :=
begin
  simp only [has_finite_integral, ← nndist_eq_nnnorm, ← edist_nndist, ← edist_comm y₀] at hi,
  have : ∀ n, measurable (λ x, edist (approx_on f hf s y₀ h₀ n x) (f x)) :=
    λ n, (approx_on f hf s y₀ h₀ n).measurable_bind (λ y x, edist y (f x))
      (λ y, measurable_edist_right.comp hf),
  convert tendsto_lintegral_of_dominated_convergence _ this
    (λ n, eventually_of_forall $ λ x, edist_approx_on_le hf h₀ x n) hi (hμ.mono $ λ x hx, _),
  show tendsto (λ n, edist _ (f x)) at_top (𝓝 $ edist (f x) (f x)),
    from (tendsto_approx_on hf h₀ hx).edist tendsto_const_nhds,
  simp
end

lemma integrable_approx_on [borel_space E]
  {f : β → E} {μ : measure β} (fmeas : measurable f) (hf : integrable f μ)
  {s : set E} {y₀ : E} (h₀ : y₀ ∈ s)
  [separable_space s] (hi₀ : integrable (λ x, y₀) μ) (n : ℕ) :
  integrable (approx_on f fmeas s y₀ h₀ n) μ :=
begin
  refine ⟨(approx_on f fmeas s y₀ h₀ n).ae_measurable, _⟩,
  suffices : integrable (λ x, approx_on f fmeas s y₀ h₀ n x - y₀) μ,
  { convert this.add' hi₀, ext1 x, simp },
  refine ⟨(approx_on f fmeas s y₀ h₀ n - const β y₀).ae_measurable, _⟩,
  have hi := hf.sub' hi₀,
  simp only [has_finite_integral, ← nndist_eq_nnnorm, ← edist_nndist, edist_comm _ y₀,
    pi.sub_apply] at hi ⊢,
  have : measurable (λ x, edist y₀ (f x)) := measurable_edist_right.comp fmeas,
  calc
  ∫⁻ x, edist y₀ (approx_on f fmeas s y₀ h₀ n x) ∂μ ≤ ∫⁻ x, edist y₀ (f x) + edist y₀ (f x) ∂μ :
    measure_theory.lintegral_mono (λ x, edist_approx_on_y0_le fmeas h₀ x n)
  ... = ∫⁻ x, edist y₀ (f x) ∂μ + ∫⁻ x, edist y₀ (f x) ∂μ :
    measure_theory.lintegral_add this this
  ... < ∞ :
    add_lt_top.2 ⟨hi, hi⟩
end

lemma tendsto_approx_on_univ_L1_edist [opens_measurable_space E] [second_countable_topology E]
  {f : β → E} {μ : measure β} (fmeas : measurable f) (hf : integrable f μ) :
  tendsto (λ n, ∫⁻ x, edist (approx_on f fmeas univ 0 trivial n x) (f x) ∂μ) at_top (𝓝 0) :=
tendsto_approx_on_L1_edist fmeas trivial (by simp) (by simpa using hf.2)

lemma integrable_approx_on_univ [borel_space E] [second_countable_topology E]
  {f : β → E} {μ : measure β} (fmeas : measurable f) (hf : integrable f μ) (n : ℕ) :
  integrable (approx_on f fmeas univ 0 trivial n) μ :=
integrable_approx_on fmeas hf _ (integrable_zero _ _ _) n

lemma tendsto_approx_on_univ_L1 [borel_space E] [second_countable_topology E]
  {f : β → E} {μ : measure β} (fmeas : measurable f) (hf : integrable f μ) :
  tendsto (λ n, integrable.to_L1 (approx_on f fmeas univ 0 trivial n)
    (integrable_approx_on_univ fmeas hf n)) at_top (𝓝 $ hf.to_L1 f) :=
tendsto_iff_edist_tendsto_0.2 $  by simpa using tendsto_approx_on_univ_L1_edist fmeas hf

end simple_func

end measure_theory


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

Here an "ordered_ring" is partially ordered ring, which is ordered with respect to both a weak
order and an associated strict order. Our numeric structures (int, rat, and real) will be instances
of "linear_ordered_comm_ring". This development is modeled after Isabelle's library.
-/

import algebra.ordered_group algebra.ring
open eq eq.ops

variable {A : Type}

private definition absurd_a_lt_a {B : Type} {a : A} [s : strict_order A] (H : a < a) : B :=
absurd H (lt.irrefl a)

/- semiring structures -/

structure ordered_semiring [class] (A : Type)
  extends semiring A, ordered_cancel_comm_monoid A :=
(mul_le_mul_of_nonneg_left: ∀a b c, le a b → le zero c → le (mul c a) (mul c b))
(mul_le_mul_of_nonneg_right: ∀a b c, le a b → le zero c → le (mul a c) (mul b c))
(mul_lt_mul_of_pos_left: ∀a b c, lt a b → lt zero c → lt (mul c a) (mul c b))
(mul_lt_mul_of_pos_right: ∀a b c, lt a b → lt zero c → lt (mul a c) (mul b c))

section
  variable [s : ordered_semiring A]
  variables (a b c d e : A)
  include s

  theorem mul_le_mul_of_nonneg_left {a b c : A} (Hab : a ≤ b) (Hc : 0 ≤ c) :
    c * a ≤ c * b := !ordered_semiring.mul_le_mul_of_nonneg_left Hab Hc

  theorem mul_le_mul_of_nonneg_right {a b c : A} (Hab : a ≤ b) (Hc : 0 ≤ c) :
    a * c ≤ b * c := !ordered_semiring.mul_le_mul_of_nonneg_right Hab Hc

  -- TODO: there are four variations, depending on which variables we assume to be nonneg
  theorem mul_le_mul {a b c d : A} (Hac : a ≤ c) (Hbd : b ≤ d) (nn_b : 0 ≤ b) (nn_c : 0 ≤ c) :
    a * b ≤ c * d :=
  calc
    a * b ≤ c * b : mul_le_mul_of_nonneg_right Hac nn_b
      ... ≤ c * d : mul_le_mul_of_nonneg_left Hbd nn_c

  theorem mul_nonneg {a b : A} (Ha : a ≥ 0) (Hb : b ≥ 0) : a * b ≥ 0 :=
  begin
    have H : 0 * b ≤ a * b, from mul_le_mul_of_nonneg_right Ha Hb,
    rewrite zero_mul at H,
    exact H
  end

  theorem mul_nonpos_of_nonneg_of_nonpos {a b : A} (Ha : a ≥ 0) (Hb : b ≤ 0) : a * b ≤ 0 :=
  begin
    have H : a * b ≤ a * 0, from mul_le_mul_of_nonneg_left Hb Ha,
    rewrite mul_zero at H,
    exact H
  end

  theorem mul_nonpos_of_nonpos_of_nonneg {a b : A} (Ha : a ≤ 0) (Hb : b ≥ 0) : a * b ≤ 0 :=
  begin
    have H : a * b ≤ 0 * b, from mul_le_mul_of_nonneg_right Ha Hb,
    rewrite zero_mul at H,
    exact H
  end

  theorem mul_lt_mul_of_pos_left {a b c : A} (Hab : a < b) (Hc : 0 < c) :
    c * a < c * b := !ordered_semiring.mul_lt_mul_of_pos_left Hab Hc

  theorem mul_lt_mul_of_pos_right {a b c : A} (Hab : a < b) (Hc : 0 < c) :
    a * c < b * c := !ordered_semiring.mul_lt_mul_of_pos_right Hab Hc

  -- TODO: once again, there are variations
  theorem mul_lt_mul {a b c d : A} (Hac : a < c) (Hbd : b ≤ d) (pos_b : 0 < b) (nn_c : 0 ≤ c) :
    a * b < c * d :=
  calc
    a * b < c * b : mul_lt_mul_of_pos_right Hac pos_b
      ... ≤ c * d : mul_le_mul_of_nonneg_left Hbd nn_c

  theorem mul_lt_mul' {a b c d : A} (H1 : a < c) (H2 : b < d) (H3 : b ≥ 0) (H4 : c > 0) :
        a * b < c * d :=
  calc
    a * b ≤ c * b : mul_le_mul_of_nonneg_right (le_of_lt H1) H3
      ... < c * d : mul_lt_mul_of_pos_left H2 H4

  theorem mul_pos {a b : A} (Ha : a > 0) (Hb : b > 0) : a * b > 0 :=
  begin
    have H : 0 * b < a * b, from mul_lt_mul_of_pos_right Ha Hb,
    rewrite zero_mul at H,
    exact H
  end

  theorem mul_neg_of_pos_of_neg {a b : A} (Ha : a > 0) (Hb : b < 0) : a * b < 0 :=
  begin
    have H : a * b < a * 0, from mul_lt_mul_of_pos_left Hb Ha,
    rewrite mul_zero at H,
    exact H
  end

  theorem mul_neg_of_neg_of_pos {a b : A} (Ha : a < 0) (Hb : b > 0) : a * b < 0 :=
  begin
    have H : a * b < 0 * b, from mul_lt_mul_of_pos_right Ha Hb,
    rewrite zero_mul at  H,
    exact H
  end

  theorem mul_self_lt_mul_self {a b : A} (H1 : 0 ≤ a) (H2 : a < b) : a * a < b * b :=
  mul_lt_mul' H2 H2 H1 (lt_of_le_of_lt H1 H2)
end

structure linear_ordered_semiring [class] (A : Type)
  extends ordered_semiring A, linear_strong_order_pair A :=
(zero_lt_one : lt zero one)

section
  variable [s : linear_ordered_semiring A]
  variables {a b c : A}
  include s

  theorem zero_lt_one : 0 < (1:A) := linear_ordered_semiring.zero_lt_one A
  theorem zero_le_one : 0 ≤ (1:A) := le_of_lt zero_lt_one

  theorem lt_of_mul_lt_mul_left (H : c * a < c * b) (Hc : c ≥ 0) : a < b :=
  lt_of_not_ge
    (assume H1 : b ≤ a,
      have H2 : c * b ≤ c * a, from mul_le_mul_of_nonneg_left H1 Hc,
      not_lt_of_ge H2 H)

  theorem lt_of_mul_lt_mul_right (H : a * c < b * c) (Hc : c ≥ 0) : a < b :=
  lt_of_not_ge
    (assume H1 : b ≤ a,
      have H2 : b * c ≤ a * c, from mul_le_mul_of_nonneg_right H1 Hc,
      not_lt_of_ge H2 H)

  theorem le_of_mul_le_mul_left (H : c * a ≤ c * b) (Hc : c > 0) : a ≤ b :=
  le_of_not_gt
    (assume H1 : b < a,
      have H2 : c * b < c * a, from mul_lt_mul_of_pos_left H1 Hc,
      not_le_of_gt H2 H)

  theorem le_of_mul_le_mul_right (H : a * c ≤ b * c) (Hc : c > 0) : a ≤ b :=
  le_of_not_gt
    (assume H1 : b < a,
      have H2 : b * c < a * c, from mul_lt_mul_of_pos_right H1 Hc,
      not_le_of_gt H2 H)

  theorem le_iff_mul_le_mul_left (a b : A) {c : A} (H : c > 0) : a ≤ b ↔ c * a ≤ c * b :=
  iff.intro
    (assume H', mul_le_mul_of_nonneg_left H' (le_of_lt H))
    (assume H', le_of_mul_le_mul_left H' H)

  theorem le_iff_mul_le_mul_right (a b : A) {c : A} (H : c > 0) : a ≤ b ↔ a * c ≤ b * c :=
  iff.intro
    (assume H', mul_le_mul_of_nonneg_right H' (le_of_lt H))
    (assume H', le_of_mul_le_mul_right H' H)

  theorem pos_of_mul_pos_left (H : 0 < a * b) (H1 : 0 ≤ a) : 0 < b :=
  lt_of_not_ge
    (assume H2 : b ≤ 0,
      have H3 : a * b ≤ 0, from mul_nonpos_of_nonneg_of_nonpos H1 H2,
      not_lt_of_ge H3 H)

  theorem pos_of_mul_pos_right (H : 0 < a * b) (H1 : 0 ≤ b) : 0 < a :=
  lt_of_not_ge
    (assume H2 : a ≤ 0,
      have H3 : a * b ≤ 0, from mul_nonpos_of_nonpos_of_nonneg H2 H1,
      not_lt_of_ge H3 H)

  theorem nonneg_of_mul_nonneg_left (H : 0 ≤ a * b) (H1 : 0 < a) : 0 ≤ b :=
  le_of_not_gt
    (assume H2 : b < 0,
      not_le_of_gt (mul_neg_of_pos_of_neg H1 H2) H)

  theorem nonneg_of_mul_nonneg_right (H : 0 ≤ a * b) (H1 : 0 < b) : 0 ≤ a :=
  le_of_not_gt
    (assume H2 : a < 0,
      not_le_of_gt (mul_neg_of_neg_of_pos H2 H1) H)

  theorem neg_of_mul_neg_left (H : a * b < 0) (H1 : 0 ≤ a) : b < 0 :=
  lt_of_not_ge
    (assume H2 : b ≥ 0,
      not_lt_of_ge (mul_nonneg H1 H2) H)

  theorem neg_of_mul_neg_right (H : a * b < 0) (H1 : 0 ≤ b) : a < 0 :=
  lt_of_not_ge
    (assume H2 : a ≥ 0,
      not_lt_of_ge (mul_nonneg H2 H1) H)

  theorem nonpos_of_mul_nonpos_left (H : a * b ≤ 0) (H1 : 0 < a) : b ≤ 0 :=
  le_of_not_gt
    (assume H2 : b > 0,
      not_le_of_gt (mul_pos H1 H2) H)

  theorem nonpos_of_mul_nonpos_right (H : a * b ≤ 0) (H1 : 0 < b) : a ≤ 0 :=
  le_of_not_gt
    (assume H2 : a > 0,
      not_le_of_gt (mul_pos H2 H1) H)
end

structure decidable_linear_ordered_semiring [class] (A : Type)
  extends linear_ordered_semiring A, decidable_linear_ordered_cancel_comm_monoid A

/- ring structures -/

structure ordered_ring [class] (A : Type)
    extends ring A, ordered_comm_group A, zero_ne_one_class A :=
(mul_nonneg : ∀a b, le zero a → le zero b → le zero (mul a b))
(mul_pos : ∀a b, lt zero a → lt zero b → lt zero (mul a b))

theorem ordered_ring.mul_le_mul_of_nonneg_left [s : ordered_ring A] {a b c : A}
        (Hab : a ≤ b) (Hc : 0 ≤ c) : c * a ≤ c * b :=
have H1 : 0 ≤ b - a, from iff.elim_right !sub_nonneg_iff_le Hab,
have H2 : 0 ≤ c * (b - a), from ordered_ring.mul_nonneg _ _ Hc H1,
begin
  rewrite mul_sub_left_distrib at H2,
  exact (iff.mp !sub_nonneg_iff_le H2)
end

theorem ordered_ring.mul_le_mul_of_nonneg_right [s : ordered_ring A] {a b c : A}
        (Hab : a ≤ b) (Hc : 0 ≤ c) : a * c ≤ b * c  :=
have H1 : 0 ≤ b - a, from iff.elim_right !sub_nonneg_iff_le Hab,
have H2 : 0 ≤ (b - a) * c, from ordered_ring.mul_nonneg _ _ H1 Hc,
begin
  rewrite mul_sub_right_distrib at H2,
  exact (iff.mp !sub_nonneg_iff_le H2)
end

theorem ordered_ring.mul_lt_mul_of_pos_left [s : ordered_ring A] {a b c : A}
       (Hab : a < b) (Hc : 0 < c) : c * a < c * b :=
have H1 : 0 < b - a, from iff.elim_right !sub_pos_iff_lt Hab,
have H2 : 0 < c * (b - a), from ordered_ring.mul_pos _ _ Hc H1,
begin
  rewrite mul_sub_left_distrib at H2,
  exact (iff.mp !sub_pos_iff_lt H2)
end

theorem ordered_ring.mul_lt_mul_of_pos_right [s : ordered_ring A] {a b c : A}
       (Hab : a < b) (Hc : 0 < c) : a * c < b * c :=
have H1 : 0 < b - a, from iff.elim_right !sub_pos_iff_lt Hab,
have H2 : 0 < (b - a) * c, from ordered_ring.mul_pos _ _ H1 Hc,
begin
  rewrite mul_sub_right_distrib at H2,
  exact (iff.mp !sub_pos_iff_lt H2)
end

definition ordered_ring.to_ordered_semiring [trans_instance]
    [s : ordered_ring A] :
  ordered_semiring A :=
⦃ ordered_semiring, s,
  mul_zero                   := mul_zero,
  zero_mul                   := zero_mul,
  add_left_cancel            := @add.left_cancel A _,
  add_right_cancel           := @add.right_cancel A _,
  le_of_add_le_add_left      := @le_of_add_le_add_left A _,
  mul_le_mul_of_nonneg_left  := @ordered_ring.mul_le_mul_of_nonneg_left A _,
  mul_le_mul_of_nonneg_right := @ordered_ring.mul_le_mul_of_nonneg_right A _,
  mul_lt_mul_of_pos_left     := @ordered_ring.mul_lt_mul_of_pos_left A _,
  mul_lt_mul_of_pos_right    := @ordered_ring.mul_lt_mul_of_pos_right A _,
  lt_of_add_lt_add_left      := @lt_of_add_lt_add_left A _⦄

section
  variable [s : ordered_ring A]
  variables {a b c : A}
  include s

  theorem mul_le_mul_of_nonpos_left (H : b ≤ a) (Hc : c ≤ 0) : c * a ≤ c * b :=
  have Hc' : -c ≥ 0, from iff.mpr !neg_nonneg_iff_nonpos Hc,
  have H1 : -c * b ≤ -c * a, from mul_le_mul_of_nonneg_left H Hc',
  have H2 : -(c * b) ≤ -(c * a),
    begin
      rewrite [-*neg_mul_eq_neg_mul at H1],
      exact H1
    end,
  iff.mp !neg_le_neg_iff_le H2

  theorem mul_le_mul_of_nonpos_right (H : b ≤ a) (Hc : c ≤ 0) : a * c ≤ b * c :=
  have Hc' : -c ≥ 0, from iff.mpr !neg_nonneg_iff_nonpos Hc,
  have H1 : b * -c ≤ a * -c, from mul_le_mul_of_nonneg_right H Hc',
  have H2 : -(b * c) ≤ -(a * c),
    begin
      rewrite [-*neg_mul_eq_mul_neg at H1],
      exact H1
    end,
  iff.mp !neg_le_neg_iff_le H2

  theorem mul_nonneg_of_nonpos_of_nonpos (Ha : a ≤ 0) (Hb : b ≤ 0) : 0 ≤ a * b :=
  begin
    have H : 0 * b ≤ a * b, from mul_le_mul_of_nonpos_right Ha Hb,
    rewrite zero_mul at H,
    exact H
  end

  theorem mul_lt_mul_of_neg_left (H : b < a) (Hc : c < 0) : c * a < c * b :=
  have Hc' : -c > 0, from iff.mpr !neg_pos_iff_neg Hc,
  have H1 : -c * b < -c * a, from mul_lt_mul_of_pos_left H Hc',
  have H2 : -(c * b) < -(c * a),
    begin
      rewrite [-*neg_mul_eq_neg_mul at H1],
      exact H1
    end,
  iff.mp !neg_lt_neg_iff_lt H2

  theorem mul_lt_mul_of_neg_right (H : b < a) (Hc : c < 0) : a * c < b * c :=
  have Hc' : -c > 0, from iff.mpr !neg_pos_iff_neg Hc,
  have H1 : b * -c < a * -c, from mul_lt_mul_of_pos_right H Hc',
  have H2 : -(b * c) < -(a * c),
    begin
      rewrite [-*neg_mul_eq_mul_neg at H1],
      exact H1
    end,
  iff.mp !neg_lt_neg_iff_lt H2

  theorem mul_pos_of_neg_of_neg (Ha : a < 0) (Hb : b < 0) : 0 < a * b :=
  begin
    have H : 0 * b < a * b, from mul_lt_mul_of_neg_right Ha Hb,
    rewrite zero_mul at H,
    exact H
  end

end

-- TODO: we can eliminate mul_pos_of_pos, but now it is not worth the effort to redeclare the
-- class instance
structure linear_ordered_ring [class] (A : Type)
    extends ordered_ring A, linear_strong_order_pair A :=
  (zero_lt_one : lt zero one)

definition linear_ordered_ring.to_linear_ordered_semiring [trans_instance]
    [s : linear_ordered_ring A] :
  linear_ordered_semiring A :=
⦃ linear_ordered_semiring, s,
  mul_zero                   := mul_zero,
  zero_mul                   := zero_mul,
  add_left_cancel            := @add.left_cancel A _,
  add_right_cancel           := @add.right_cancel A _,
  le_of_add_le_add_left      := @le_of_add_le_add_left A _,
  mul_le_mul_of_nonneg_left  := @mul_le_mul_of_nonneg_left A _,
  mul_le_mul_of_nonneg_right := @mul_le_mul_of_nonneg_right A _,
  mul_lt_mul_of_pos_left     := @mul_lt_mul_of_pos_left A _,
  mul_lt_mul_of_pos_right    := @mul_lt_mul_of_pos_right A _,
  le_total                   := linear_ordered_ring.le_total,
  lt_of_add_lt_add_left      := @lt_of_add_lt_add_left A _ ⦄

structure linear_ordered_comm_ring [class] (A : Type) extends linear_ordered_ring A, comm_monoid A

theorem linear_ordered_comm_ring.eq_zero_or_eq_zero_of_mul_eq_zero [s : linear_ordered_comm_ring A]
        {a b : A} (H : a * b = 0) : a = 0 ∨ b = 0 :=
lt.by_cases
  (assume Ha : 0 < a,
    lt.by_cases
      (assume Hb : 0 < b,
        begin
          have H1 : 0 < a * b, from mul_pos Ha Hb,
          rewrite H at H1,
          apply absurd_a_lt_a H1
        end)
      (assume Hb : 0 = b, or.inr (Hb⁻¹))
      (assume Hb : 0 > b,
        begin
          have H1 : 0 > a * b, from mul_neg_of_pos_of_neg Ha Hb,
          rewrite H at H1,
          apply absurd_a_lt_a H1
        end))
  (assume Ha : 0 = a, or.inl (Ha⁻¹))
  (assume Ha : 0 > a,
    lt.by_cases
      (assume Hb : 0 < b,
        begin
          have H1 : 0 > a * b, from mul_neg_of_neg_of_pos Ha Hb,
          rewrite H at H1,
          apply absurd_a_lt_a H1
        end)
      (assume Hb : 0 = b, or.inr (Hb⁻¹))
      (assume Hb : 0 > b,
        begin
          have H1 : 0 < a * b, from mul_pos_of_neg_of_neg Ha Hb,
          rewrite H at H1,
          apply absurd_a_lt_a H1
        end))

-- Linearity implies no zero divisors. Doesn't need commutativity.
definition linear_ordered_comm_ring.to_integral_domain [trans_instance]
    [s: linear_ordered_comm_ring A] : integral_domain A :=
⦃ integral_domain, s,
  eq_zero_or_eq_zero_of_mul_eq_zero :=
     @linear_ordered_comm_ring.eq_zero_or_eq_zero_of_mul_eq_zero A s ⦄

section
  variable [s : linear_ordered_ring A]
  variables (a b c : A)
  include s

  theorem mul_self_nonneg : a * a ≥ 0 :=
  or.elim (le.total 0 a)
    (assume H : a ≥ 0, mul_nonneg H H)
    (assume H : a ≤ 0, mul_nonneg_of_nonpos_of_nonpos H H)

  theorem pos_and_pos_or_neg_and_neg_of_mul_pos {a b : A} (Hab : a * b > 0) :
    (a > 0 ∧ b > 0) ∨ (a < 0 ∧ b < 0) :=
  lt.by_cases
    (assume Ha : 0 < a,
      lt.by_cases
        (assume Hb : 0 < b, or.inl (and.intro Ha Hb))
        (assume Hb : 0 = b,
          begin
            rewrite [-Hb at Hab, mul_zero at Hab],
            apply absurd_a_lt_a Hab
          end)
        (assume Hb : b < 0,
          absurd Hab (lt.asymm (mul_neg_of_pos_of_neg Ha Hb))))
    (assume Ha : 0 = a,
      begin
        rewrite [-Ha at Hab, zero_mul at Hab],
        apply absurd_a_lt_a Hab
      end)
    (assume Ha : a < 0,
      lt.by_cases
        (assume Hb : 0 < b,
          absurd Hab (lt.asymm (mul_neg_of_neg_of_pos Ha Hb)))
        (assume Hb : 0 = b,
          begin
            rewrite [-Hb at Hab, mul_zero at Hab],
            apply absurd_a_lt_a Hab
          end)
        (assume Hb : b < 0, or.inr (and.intro Ha Hb)))

  theorem gt_of_mul_lt_mul_neg_left {a b c : A} (H : c * a < c * b) (Hc : c ≤ 0) : a > b :=
    have nhc : -c ≥ 0, from neg_nonneg_of_nonpos Hc,
    have H2 : -(c * b) < -(c * a), from iff.mpr (neg_lt_neg_iff_lt _ _) H,
    have H3 : (-c) * b < (-c) * a, from calc
      (-c) * b = - (c * b)    : neg_mul_eq_neg_mul
           ... < -(c * a)     : H2
           ... = (-c) * a     : neg_mul_eq_neg_mul,
    lt_of_mul_lt_mul_left H3 nhc

  theorem zero_gt_neg_one : -1 < (0:A) :=
    neg_zero ▸ (neg_lt_neg zero_lt_one)

  theorem le_of_mul_le_of_ge_one {a b c : A} (H : a * c ≤ b) (Hb : b ≥ 0) (Hc : c ≥ 1) : a ≤ b :=
    have H' : a * c ≤ b * c, from calc
      a * c ≤ b : H
        ... = b * 1 : mul_one
        ... ≤ b * c : mul_le_mul_of_nonneg_left Hc Hb,
    le_of_mul_le_mul_right H' (lt_of_lt_of_le zero_lt_one Hc)

  theorem nonneg_le_nonneg_of_squares_le {a b : A} (Ha : a ≥ 0) (Hb : b ≥ 0) (H : a * a ≤ b * b) :
      a ≤ b :=
    begin
      apply le_of_not_gt,
      intro Hab,
      note Hposa := lt_of_le_of_lt Hb Hab,
      note H' := calc
        b * b ≤ a * b : mul_le_mul_of_nonneg_right (le_of_lt Hab) Hb
        ... < a * a : mul_lt_mul_of_pos_left Hab Hposa,
      apply (not_le_of_gt H') H
    end
end

/- TODO: Isabelle's library has all kinds of cancelation rules for the simplifier.
   Search on mult_le_cancel_right1 in Rings.thy. -/

structure decidable_linear_ordered_comm_ring [class] (A : Type) extends linear_ordered_comm_ring A,
    decidable_linear_ordered_comm_group A

definition decidable_linear_ordered_comm_ring.to_decidable_linear_ordered_semiring
    [trans_instance] [s : decidable_linear_ordered_comm_ring A] :
  decidable_linear_ordered_semiring A :=
⦃decidable_linear_ordered_semiring, s, @linear_ordered_ring.to_linear_ordered_semiring A _⦄

section
  variable [s : decidable_linear_ordered_comm_ring A]
  variables {a b c : A}
  include s

  definition sign (a : A) : A := lt.cases a 0 (-1) 0 1

  theorem sign_of_neg (H : a < 0) : sign a = -1 := lt.cases_of_lt H

  theorem sign_zero : sign 0 = (0:A) := lt.cases_of_eq rfl

  theorem sign_of_pos (H : a > 0) : sign a = 1 := lt.cases_of_gt H

  theorem sign_one : sign 1 = (1:A) := sign_of_pos zero_lt_one

  theorem sign_neg_one : sign (-1) = -(1:A) := sign_of_neg (neg_neg_of_pos zero_lt_one)

  theorem sign_sign (a : A) : sign (sign a) = sign a :=
  lt.by_cases
    (assume H : a > 0,
      calc
        sign (sign a) = sign 1 : by rewrite (sign_of_pos H)
                  ... = 1      : by rewrite sign_one
                  ... = sign a : by rewrite (sign_of_pos H))
    (assume H : 0 = a,
      calc
        sign (sign a) = sign (sign 0) : by rewrite H
                  ... = sign 0        : by rewrite sign_zero at {1}
                  ... = sign a        : by rewrite -H)
    (assume H : a < 0,
      calc
        sign (sign a) = sign (-1)     : by rewrite (sign_of_neg H)
                  ... = -1            : by rewrite sign_neg_one
                  ... = sign a        : by rewrite (sign_of_neg H))

  theorem pos_of_sign_eq_one (H : sign a = 1) : a > 0 :=
  lt.by_cases
    (assume H1 : 0 < a, H1)
    (assume H1 : 0 = a,
      begin
        rewrite [-H1 at H, sign_zero at H],
        apply absurd H zero_ne_one
      end)
    (assume H1 : 0 > a,
      have H2 : -1 = 1, from (sign_of_neg H1)⁻¹ ⬝ H,
      absurd ((eq_zero_of_neg_eq H2)⁻¹) zero_ne_one)

  theorem eq_zero_of_sign_eq_zero (H : sign a = 0) : a = 0 :=
  lt.by_cases
    (assume H1 : 0 < a,
      absurd (H⁻¹ ⬝ sign_of_pos H1) zero_ne_one)
    (assume H1 : 0 = a, H1⁻¹)
    (assume H1 : 0 > a,
      have H2 : 0 = -1, from H⁻¹ ⬝ sign_of_neg H1,
      have H3 : 1 = 0, from eq_neg_of_eq_neg H2 ⬝ neg_zero,
      absurd (H3⁻¹) zero_ne_one)

  theorem neg_of_sign_eq_neg_one (H : sign a = -1) : a < 0 :=
  lt.by_cases
    (assume H1 : 0 < a,
      have H2 : -1 = 1, from H⁻¹ ⬝ (sign_of_pos H1),
      absurd ((eq_zero_of_neg_eq H2)⁻¹) zero_ne_one)
    (assume H1 : 0 = a,
      have H2 : (0:A) = -1,
        begin
          rewrite [-H1 at H, sign_zero at H],
          exact H
        end,
      have H3 : 1 = 0, from eq_neg_of_eq_neg H2 ⬝ neg_zero,
      absurd (H3⁻¹) zero_ne_one)
    (assume H1 : 0 > a, H1)

  theorem sign_neg (a : A) : sign (-a) = -(sign a) :=
  lt.by_cases
    (assume H1 : 0 < a,
      calc
        sign (-a) = -1        : sign_of_neg (neg_neg_of_pos H1)
              ... = -(sign a) : by rewrite (sign_of_pos H1))
    (assume H1 : 0 = a,
      calc
        sign (-a) = sign (-0) : by rewrite H1
              ... = sign 0    : by rewrite neg_zero
              ... = 0         : by rewrite sign_zero
              ... = -0        : by rewrite neg_zero
              ... = -(sign 0) : by rewrite sign_zero
              ... = -(sign a) : by rewrite -H1)
    (assume H1 : 0 > a,
      calc
        sign (-a) = 1         : sign_of_pos (neg_pos_of_neg H1)
              ... = -(-1)     : by rewrite neg_neg
              ... = -(sign a) : sign_of_neg H1)

  theorem sign_mul (a b : A) : sign (a * b) = sign a * sign b :=
  lt.by_cases
    (assume z_lt_a : 0 < a,
      lt.by_cases
       (assume z_lt_b : 0 < b,
         by rewrite [sign_of_pos z_lt_a, sign_of_pos z_lt_b,
                     sign_of_pos (mul_pos z_lt_a z_lt_b), one_mul])
       (assume z_eq_b : 0 = b, by rewrite [-z_eq_b, mul_zero, *sign_zero, mul_zero])
       (assume z_gt_b : 0 > b,
         by rewrite [sign_of_pos z_lt_a, sign_of_neg z_gt_b,
                     sign_of_neg (mul_neg_of_pos_of_neg z_lt_a z_gt_b), one_mul]))
    (assume z_eq_a : 0 = a, by rewrite [-z_eq_a, zero_mul, *sign_zero, zero_mul])
    (assume z_gt_a : 0 > a,
      lt.by_cases
       (assume z_lt_b : 0 < b,
         by rewrite [sign_of_neg z_gt_a, sign_of_pos z_lt_b,
                     sign_of_neg (mul_neg_of_neg_of_pos z_gt_a z_lt_b), mul_one])
       (assume z_eq_b : 0 = b, by rewrite [-z_eq_b, mul_zero, *sign_zero, mul_zero])
       (assume z_gt_b : 0 > b,
         by rewrite [sign_of_neg z_gt_a, sign_of_neg z_gt_b,
                     sign_of_pos (mul_pos_of_neg_of_neg z_gt_a z_gt_b),
                     neg_mul_neg, one_mul]))

  theorem abs_eq_sign_mul (a : A) : abs a = sign a * a :=
  lt.by_cases
    (assume H1 : 0 < a,
      calc
        abs a = a          : abs_of_pos H1
        ... = 1 * a        : by rewrite one_mul
        ... = sign a * a   : by rewrite (sign_of_pos H1))
    (assume H1 : 0 = a,
      calc
        abs a = abs 0    : by rewrite H1
        ... = 0          : by rewrite abs_zero
        ... = 0 * a      : by rewrite zero_mul
        ... = sign 0 * a : by rewrite sign_zero
        ... = sign a * a : by rewrite H1)
    (assume H1 : a < 0,
      calc
        abs a = -a         : abs_of_neg H1
          ... = -1 * a     : by rewrite neg_eq_neg_one_mul
          ... = sign a * a : by rewrite (sign_of_neg H1))

  theorem eq_sign_mul_abs (a : A) : a = sign a * abs a :=
  lt.by_cases
    (assume H1 : 0 < a,
      calc
        a = abs a              : abs_of_pos H1
          ... = 1 * abs a      : by rewrite one_mul
          ... = sign a * abs a : by rewrite (sign_of_pos H1))
    (assume H1 : 0 = a,
      calc
        a = 0                  : H1⁻¹
          ... = 0 * abs a      : by rewrite zero_mul
          ... = sign 0 * abs a : by rewrite sign_zero
          ... = sign a * abs a : by rewrite H1)
    (assume H1 : a < 0,
      calc
        a = -(-a)              : by rewrite neg_neg
          ... = -abs a         : by rewrite (abs_of_neg H1)
          ... = -1 * abs a     : by rewrite neg_eq_neg_one_mul
          ... = sign a * abs a : by rewrite (sign_of_neg H1))

  theorem abs_dvd_iff (a b : A) : abs a ∣ b ↔ a ∣ b :=
  abs.by_cases !iff.refl !neg_dvd_iff_dvd

  theorem abs_dvd_of_dvd {a b : A} : a ∣ b → abs a ∣ b :=
    iff.mpr !abs_dvd_iff

  theorem dvd_abs_iff (a b : A) : a ∣ abs b ↔ a ∣ b :=
  abs.by_cases !iff.refl !dvd_neg_iff_dvd

  theorem dvd_abs_of_dvd {a b : A} : a ∣ b → a ∣ abs b :=
    iff.mpr !dvd_abs_iff

  theorem abs_mul (a b : A) : abs (a * b) = abs a * abs b :=
  or.elim (le.total 0 a)
    (assume H1 : 0 ≤ a,
      or.elim (le.total 0 b)
        (assume H2 : 0 ≤ b,
          calc
            abs (a * b) = a * b         : abs_of_nonneg (mul_nonneg H1 H2)
                    ... = abs a * b     : by rewrite (abs_of_nonneg H1)
                    ... = abs a * abs b : by rewrite (abs_of_nonneg H2))
        (assume H2 : b ≤ 0,
          calc
            abs (a * b) = -(a * b)      : abs_of_nonpos (mul_nonpos_of_nonneg_of_nonpos H1 H2)
                    ... = a * -b        : by rewrite neg_mul_eq_mul_neg
                    ... = abs a * -b    : by rewrite (abs_of_nonneg H1)
                    ... = abs a * abs b : by rewrite (abs_of_nonpos H2)))
    (assume H1 : a ≤ 0,
      or.elim (le.total 0 b)
        (assume H2 : 0 ≤ b,
          calc
            abs (a * b) = -(a * b)      : abs_of_nonpos (mul_nonpos_of_nonpos_of_nonneg H1 H2)
                    ... = -a * b        : by rewrite neg_mul_eq_neg_mul
                    ... = abs a * b     : by rewrite (abs_of_nonpos H1)
                    ... = abs a * abs b : by rewrite (abs_of_nonneg H2))
        (assume H2 : b ≤ 0,
          calc
            abs (a * b) = a * b         : abs_of_nonneg (mul_nonneg_of_nonpos_of_nonpos H1 H2)
                    ... = -a * -b       : by rewrite neg_mul_neg
                    ... = abs a * -b    : by rewrite (abs_of_nonpos H1)
                    ... = abs a * abs b : by rewrite (abs_of_nonpos H2)))

  theorem abs_mul_abs_self (a : A) : abs a * abs a = a * a :=
  abs.by_cases rfl !neg_mul_neg

  theorem abs_mul_self (a : A) : abs (a * a) = a * a :=
  by rewrite [abs_mul, abs_mul_abs_self]

  theorem sub_le_of_abs_sub_le_left (H : abs (a - b) ≤ c) : b - c ≤ a :=
    if Hz : 0 ≤ a - b then
      (calc
        a ≥ b : (iff.mp !sub_nonneg_iff_le) Hz
      ... ≥ b - c : sub_le_of_nonneg _ (le.trans !abs_nonneg H))
    else
      (have Habs : b - a ≤ c, by rewrite [abs_of_neg (lt_of_not_ge Hz) at H, neg_sub at H]; apply H,
       have Habs' : b ≤ c + a, from (iff.mpr !le_add_iff_sub_right_le) Habs,
       (iff.mp !le_add_iff_sub_left_le) Habs')

  theorem sub_le_of_abs_sub_le_right (H : abs (a - b) ≤ c) : a - c ≤ b :=
    sub_le_of_abs_sub_le_left (!abs_sub ▸ H)

  theorem sub_lt_of_abs_sub_lt_left (H : abs (a - b) < c) : b - c < a :=
    if Hz : 0 ≤ a - b then
      (calc
        a ≥ b : (iff.mp !sub_nonneg_iff_le) Hz
      ... > b - c : sub_lt_of_pos _ (lt_of_le_of_lt !abs_nonneg H))
    else
      (have Habs : b - a < c, by rewrite [abs_of_neg (lt_of_not_ge Hz) at H, neg_sub at H]; apply H,
       have Habs' : b < c + a, from lt_add_of_sub_lt_right Habs,
       sub_lt_left_of_lt_add Habs')

  theorem sub_lt_of_abs_sub_lt_right (H : abs (a - b) < c) : a - c < b :=
    sub_lt_of_abs_sub_lt_left (!abs_sub ▸ H)

  theorem abs_sub_square (a b : A) : abs (a - b) * abs (a - b) = a * a + b * b - (1 + 1) * a * b :=
    begin
      rewrite [abs_mul_abs_self, *mul_sub_left_distrib, *mul_sub_right_distrib,
               sub_eq_add_neg (a*b), sub_add_eq_sub_sub, sub_neg_eq_add, *right_distrib, sub_add_eq_sub_sub, *one_mul,
               *add.assoc, {_ + b * b}add.comm, *sub_eq_add_neg],
      rewrite [{a*a + b*b}add.comm],
      rewrite [mul.comm b a, *add.assoc]
    end

  theorem abs_abs_sub_abs_le_abs_sub (a b : A) : abs (abs a - abs b) ≤ abs (a - b) :=
  begin
    apply nonneg_le_nonneg_of_squares_le,
    repeat apply abs_nonneg,
    rewrite [*abs_sub_square, *abs_abs, *abs_mul_abs_self],
    apply sub_le_sub_left,
    rewrite *mul.assoc,
    apply mul_le_mul_of_nonneg_left,
    rewrite -abs_mul,
    apply le_abs_self,
    apply le_of_lt,
    apply add_pos,
    apply zero_lt_one,
    apply zero_lt_one
  end

  lemma eq_zero_of_mul_self_add_mul_self_eq_zero {x y : A} (H : x * x + y * y = 0) : x = 0 :=
  have x * x ≤ (0 : A), from calc
    x * x ≤ x * x + y * y : le_add_of_nonneg_right (mul_self_nonneg y)
      ... = 0             : H,
  eq_zero_of_mul_self_eq_zero (le.antisymm this (mul_self_nonneg x))
end

/- TODO: Multiplication and one, starting with mult_right_le_one_le. -/

namespace norm_num

theorem pos_bit0_helper [s : linear_ordered_semiring A] (a : A) (H : a > 0) : bit0 a > 0 :=
  by rewrite ↑bit0; apply add_pos H H

theorem nonneg_bit0_helper [s : linear_ordered_semiring A] (a : A) (H : a ≥ 0) : bit0 a ≥ 0 :=
  by rewrite ↑bit0; apply add_nonneg H H

theorem pos_bit1_helper [s : linear_ordered_semiring A] (a : A) (H : a ≥ 0) : bit1 a > 0 :=
  begin
    rewrite ↑bit1,
    apply add_pos_of_nonneg_of_pos,
    apply nonneg_bit0_helper _ H,
    apply zero_lt_one
  end

theorem nonneg_bit1_helper [s : linear_ordered_semiring A] (a : A) (H : a ≥ 0) : bit1 a ≥ 0 :=
  by apply le_of_lt; apply pos_bit1_helper _ H

theorem nonzero_of_pos_helper [s : linear_ordered_semiring A] (a : A) (H : a > 0) : a ≠ 0 :=
  ne_of_gt H

theorem nonzero_of_neg_helper [s : linear_ordered_ring A] (a : A) (H : a ≠ 0) : -a ≠ 0 :=
  begin intro Ha, apply H, apply eq_of_neg_eq_neg, rewrite neg_zero, exact Ha end

end norm_num


/-
Copyright (c) 2021 Yourong Zang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yourong Zang
-/
import analysis.normed_space.basic
import analysis.normed_space.linear_isometry

/-!
# Conformal Linear Maps

A continuous linear map between `R`-normed spaces `X` and `Y` `is_conformal_map` if it is
a nonzero multiple of a linear isometry.

## Main definitions

* `is_conformal_map`: the main definition of conformal linear maps

## Main results

* The conformality of the composition of two conformal linear maps, the identity map
  and multiplications by nonzero constants as continuous linear maps
* `is_conformal_map_of_subsingleton`: all continuous linear maps on singleton spaces are conformal
* `is_conformal_map.preserves_angle`: if a continuous linear map is conformal, then it
                                      preserves all angles in the normed space

See `analysis.normed_space.conformal_linear_map.inner_product` for
* `is_conformal_map_iff`: a map between inner product spaces is conformal
  iff it preserves inner products up to a fixed scalar factor.

## Tags

conformal

## Warning

The definition of conformality in this file does NOT require the maps to be orientation-preserving.
-/

noncomputable theory

open linear_isometry continuous_linear_map

/-- A continuous linear map `f'` is said to be conformal if it's
    a nonzero multiple of a linear isometry. -/
def is_conformal_map {R : Type*} {X Y : Type*} [normed_field R]
  [semi_normed_group X] [semi_normed_group Y] [semi_normed_space R X] [semi_normed_space R Y]
  (f' : X →L[R] Y) :=
∃ (c : R) (hc : c ≠ 0) (li : X →ₗᵢ[R] Y), (f' : X → Y) = c • li

variables {R M N G M' : Type*} [normed_field R]
  [semi_normed_group M] [semi_normed_group N] [semi_normed_group G]
  [semi_normed_space R M] [semi_normed_space R N] [semi_normed_space R G]
  [normed_group M'] [normed_space R M']

lemma is_conformal_map_id : is_conformal_map (id R M) :=
⟨1, one_ne_zero, id, by { ext, simp }⟩

lemma is_conformal_map_const_smul {c : R} (hc : c ≠ 0) : is_conformal_map (c • (id R M)) :=
⟨c, hc, id, by { ext, simp }⟩

lemma linear_isometry.is_conformal_map (f' : M →ₗᵢ[R] N) :
  is_conformal_map f'.to_continuous_linear_map :=
⟨1, one_ne_zero, f', by { ext, simp }⟩

lemma is_conformal_map_of_subsingleton [h : subsingleton M] (f' : M →L[R] N) :
  is_conformal_map f' :=
begin
  rw subsingleton_iff at h,
  have minor : (f' : M → N) = function.const M 0 := by ext x'; rw h x' 0; exact f'.map_zero,
  have key : ∀ (x' : M), ∥(0 : M →ₗ[R] N) x'∥ = ∥x'∥ := λ x',
    by { rw [linear_map.zero_apply, h x' 0], repeat { rw norm_zero }, },
  exact ⟨(1 : R), one_ne_zero, ⟨0, key⟩,
    by { rw pi.smul_def, ext p, rw [one_smul, minor], refl, }⟩,
end

namespace is_conformal_map

lemma comp {f' : M →L[R] N} {g' : N →L[R] G}
  (hg' : is_conformal_map g') (hf' : is_conformal_map f') :
  is_conformal_map (g'.comp f') :=
begin
  rcases hf' with ⟨cf, hcf, lif, hlif⟩,
  rcases hg' with ⟨cg, hcg, lig, hlig⟩,
  refine ⟨cg * cf, mul_ne_zero hcg hcf, lig.comp lif, funext (λ x, _)⟩,
  simp only [coe_comp', linear_isometry.coe_comp, hlif, hlig, pi.smul_apply,
             function.comp_app, linear_isometry.map_smul, smul_smul],
end

lemma injective {f' : M' →L[R] N} (h : is_conformal_map f') : function.injective f' :=
let ⟨c, hc, li, hf'⟩ := h in by simp only [hf', pi.smul_def];
  exact (smul_right_injective _ hc).comp li.injective

lemma ne_zero [nontrivial M'] {f' : M' →L[R] N} (hf' : is_conformal_map f') :
  f' ≠ 0 :=
begin
  intros w,
  rcases exists_ne (0 : M') with ⟨a, ha⟩,
  have : f' a = f' 0,
  { simp_rw [w, continuous_linear_map.zero_apply], },
  exact ha (hf'.injective this),
end

end is_conformal_map