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

! This file was ported from Lean 3 source module ring_theory.derivation
! leanprover-community/mathlib commit 0324bd3f61019c744cf2e88fd9c7373eb2fdb724
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.RingTheory.Adjoin.Basic
import Mathbin.Algebra.Lie.OfAssociative
import Mathbin.RingTheory.Ideal.Cotangent
import Mathbin.RingTheory.IsTensorProduct

/-!
# Derivations

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

## Main results

- `derivation`: The type of `R`-derivations from `A` to `M`. This has an `A`-module structure.
- `derivation.llcomp`: We may compose linear maps and derivations to obtain a derivation,
  and the composition is bilinear.
- `derivation.lie_algebra`: The `R`-derivations from `A` to `A` form an lie algebra over `R`.
- `derivation_to_square_zero_equiv_lift`: The `R`-derivations from `A` into a square-zero ideal `I`
  of `B` corresponds to the lifts `A →ₐ[R] B` of the map `A →ₐ[R] B ⧸ I`.
- `kaehler_differential`: The module of kaehler differentials. For an `R`-algebra `S`, we provide
  the notation `Ω[S⁄R]` for `kaehler_differential R S`.
  Note that the slash is `\textfractionsolidus`.
- `kaehler_differential.D`: The derivation into the module of kaehler differentials.
- `kaehler_differential.span_range_derivation`: The image of `D` spans `Ω[S⁄R]` as an `S`-module.
- `kaehler_differential.linear_map_equiv_derivation`:
  The isomorphism `Hom_R(Ω[S⁄R], M) ≃ₗ[S] Der_R(S, M)`.
- `kaehler_differential.quot_ker_total_equiv`: An alternative description of `Ω[S⁄R]` as `S` copies
  of `S` with kernel (`kaehler_differential.ker_total`) generated by the relations:
  1. `dx + dy = d(x + y)`
  2. `x dy + y dx = d(x * y)`
  3. `dr = 0` for `r ∈ R`
- `kaehler_differential.map`: Given a map between the arrows `R → A` and `S → B`, we have an
  `A`-linear map `Ω[A⁄R] → Ω[B⁄S]`.

## Future project

- Generalize derivations into bimodules.
- Define a `is_kaehler_differential` predicate.

-/

open Algebra

open BigOperators

/-- `D : derivation R A M` is an `R`-linear map from `A` to `M` that satisfies the `leibniz`
equality. We also require that `D 1 = 0`. See `derivation.mk'` for a constructor that deduces this
assumption from the Leibniz rule when `M` is cancellative.

TODO: update this when bimodules are defined. -/
@[protect_proj]
structure Derivation (R : Type _) (A : Type _) [CommSemiring R] [CommSemiring A] [Algebra R A]
  (M : Type _) [AddCommMonoid M] [Module A M] [Module R M] extends A →ₗ[R] M where
  map_one_eq_zero' : to_linear_map 1 = 0
  leibniz' (a b : A) : to_linear_map (a * b) = a • to_linear_map b + b • to_linear_map a
#align derivation Derivation

/-- The `linear_map` underlying a `derivation`. -/
add_decl_doc Derivation.toLinearMap

namespace Derivation

section

variable {R : Type _} [CommSemiring R]

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

variable {M : Type _} [AddCommMonoid M] [Module A M] [Module R M]

variable (D : Derivation R A M) {D1 D2 : Derivation R A M} (r : R) (a b : A)

instance : AddMonoidHomClass (Derivation R A M) A M
    where
  coe D := D.toFun
  coe_injective' D1 D2 h := by
    cases D1
    cases D2
    congr
    exact FunLike.coe_injective h
  map_add D := D.toLinearMap.map_add'
  map_zero D := D.toLinearMap.map_zero

/-- Helper instance for when there's too many metavariables to apply `fun_like.has_coe_to_fun`
directly. -/
instance : CoeFun (Derivation R A M) fun _ => A → M :=
  ⟨fun D => D.toLinearMap.toFun⟩

-- Not a simp lemma because it can be proved via `coe_fn_coe` + `to_linear_map_eq_coe`
theorem toFun_eq_coe : D.toFun = ⇑D :=
  rfl
#align derivation.to_fun_eq_coe Derivation.toFun_eq_coe

instance hasCoeToLinearMap : Coe (Derivation R A M) (A →ₗ[R] M) :=
  ⟨fun D => D.toLinearMap⟩
#align derivation.has_coe_to_linear_map Derivation.hasCoeToLinearMap

@[simp]
theorem toLinearMap_eq_coe : D.toLinearMap = D :=
  rfl
#align derivation.to_linear_map_eq_coe Derivation.toLinearMap_eq_coe

@[simp]
theorem mk_coe (f : A →ₗ[R] M) (h₁ h₂) : ((⟨f, h₁, h₂⟩ : Derivation R A M) : A → M) = f :=
  rfl
#align derivation.mk_coe Derivation.mk_coe

@[simp, norm_cast]
theorem coeFn_coe (f : Derivation R A M) : ⇑(f : A →ₗ[R] M) = f :=
  rfl
#align derivation.coe_fn_coe Derivation.coeFn_coe

theorem coe_injective : @Function.Injective (Derivation R A M) (A → M) coeFn :=
  FunLike.coe_injective
#align derivation.coe_injective Derivation.coe_injective

@[ext]
theorem ext (H : ∀ a, D1 a = D2 a) : D1 = D2 :=
  FunLike.ext _ _ H
#align derivation.ext Derivation.ext

theorem congr_fun (h : D1 = D2) (a : A) : D1 a = D2 a :=
  FunLike.congr_fun h a
#align derivation.congr_fun Derivation.congr_fun

protected theorem map_add : D (a + b) = D a + D b :=
  map_add D a b
#align derivation.map_add Derivation.map_add

protected theorem map_zero : D 0 = 0 :=
  map_zero D
#align derivation.map_zero Derivation.map_zero

@[simp]
theorem map_smul : D (r • a) = r • D a :=
  D.toLinearMap.map_smul r a
#align derivation.map_smul Derivation.map_smul

@[simp]
theorem leibniz : D (a * b) = a • D b + b • D a :=
  D.leibniz' _ _
#align derivation.leibniz Derivation.leibniz

theorem map_sum {ι : Type _} (s : Finset ι) (f : ι → A) : D (∑ i in s, f i) = ∑ i in s, D (f i) :=
  D.toLinearMap.map_sum
#align derivation.map_sum Derivation.map_sum

@[simp]
theorem map_smul_of_tower {S : Type _} [SMul S A] [SMul S M] [LinearMap.CompatibleSMul A M S R]
    (D : Derivation R A M) (r : S) (a : A) : D (r • a) = r • D a :=
  D.toLinearMap.map_smul_of_tower r a
#align derivation.map_smul_of_tower Derivation.map_smul_of_tower

@[simp]
theorem map_one_eq_zero : D 1 = 0 :=
  D.map_one_eq_zero'
#align derivation.map_one_eq_zero Derivation.map_one_eq_zero

@[simp]
theorem map_algebraMap : D (algebraMap R A r) = 0 := by
  rw [← mul_one r, RingHom.map_mul, RingHom.map_one, ← smul_def, map_smul, map_one_eq_zero,
    smul_zero]
#align derivation.map_algebra_map Derivation.map_algebraMap

@[simp]
theorem map_coe_nat (n : ℕ) : D (n : A) = 0 := by
  rw [← nsmul_one, D.map_smul_of_tower n, map_one_eq_zero, smul_zero]
#align derivation.map_coe_nat Derivation.map_coe_nat

@[simp]
theorem leibniz_pow (n : ℕ) : D (a ^ n) = n • a ^ (n - 1) • D a :=
  by
  induction' n with n ihn
  · rw [pow_zero, map_one_eq_zero, zero_smul]
  · rcases(zero_le n).eq_or_lt with (rfl | hpos)
    · rw [pow_one, one_smul, pow_zero, one_smul]
    · have : a * a ^ (n - 1) = a ^ n := by rw [← pow_succ, Nat.sub_add_cancel hpos]
      simp only [pow_succ, leibniz, ihn, smul_comm a n, smul_smul a, add_smul, this,
        Nat.succ_eq_add_one, Nat.add_succ_sub_one, add_zero, one_nsmul]
#align derivation.leibniz_pow Derivation.leibniz_pow

theorem eqOn_adjoin {s : Set A} (h : Set.EqOn D1 D2 s) : Set.EqOn D1 D2 (adjoin R s) := fun x hx =>
  Algebra.adjoin_induction hx h (fun r => (D1.map_algebraMap r).trans (D2.map_algebraMap r).symm)
    (fun x y hx hy => by simp only [map_add, *]) fun x y hx hy => by simp only [leibniz, *]
#align derivation.eq_on_adjoin Derivation.eqOn_adjoin

/-- If adjoin of a set is the whole algebra, then any two derivations equal on this set are equal
on the whole algebra. -/
theorem ext_of_adjoin_eq_top (s : Set A) (hs : adjoin R s = ⊤) (h : Set.EqOn D1 D2 s) : D1 = D2 :=
  ext fun a => eqOn_adjoin h <| hs.symm ▸ trivial
#align derivation.ext_of_adjoin_eq_top Derivation.ext_of_adjoin_eq_top

-- Data typeclasses
instance : Zero (Derivation R A M) :=
  ⟨{  toLinearMap := 0
      map_one_eq_zero' := rfl
      leibniz' := fun a b => by simp only [add_zero, LinearMap.zero_apply, smul_zero] }⟩

@[simp]
theorem coe_zero : ⇑(0 : Derivation R A M) = 0 :=
  rfl
#align derivation.coe_zero Derivation.coe_zero

@[simp]
theorem coe_zero_linearMap : ↑(0 : Derivation R A M) = (0 : A →ₗ[R] M) :=
  rfl
#align derivation.coe_zero_linear_map Derivation.coe_zero_linearMap

theorem zero_apply (a : A) : (0 : Derivation R A M) a = 0 :=
  rfl
#align derivation.zero_apply Derivation.zero_apply

instance : Add (Derivation R A M) :=
  ⟨fun D1 D2 =>
    { toLinearMap := D1 + D2
      map_one_eq_zero' := by simp
      leibniz' := fun a b => by
        simp only [leibniz, LinearMap.add_apply, coe_fn_coe, smul_add, add_add_add_comm] }⟩

@[simp]
theorem coe_add (D1 D2 : Derivation R A M) : ⇑(D1 + D2) = D1 + D2 :=
  rfl
#align derivation.coe_add Derivation.coe_add

@[simp]
theorem coe_add_linearMap (D1 D2 : Derivation R A M) : ↑(D1 + D2) = (D1 + D2 : A →ₗ[R] M) :=
  rfl
#align derivation.coe_add_linear_map Derivation.coe_add_linearMap

theorem add_apply : (D1 + D2) a = D1 a + D2 a :=
  rfl
#align derivation.add_apply Derivation.add_apply

instance : Inhabited (Derivation R A M) :=
  ⟨0⟩

section Scalar

variable {S : Type _} [Monoid S] [DistribMulAction S M] [SMulCommClass R S M] [SMulCommClass S A M]

instance (priority := 100) : SMul S (Derivation R A M) :=
  ⟨fun r D =>
    { toLinearMap := r • D
      map_one_eq_zero' := by rw [LinearMap.smul_apply, coe_fn_coe, D.map_one_eq_zero, smul_zero]
      leibniz' := fun a b => by
        simp only [LinearMap.smul_apply, coe_fn_coe, leibniz, smul_add, smul_comm r] }⟩

@[simp]
theorem coe_smul (r : S) (D : Derivation R A M) : ⇑(r • D) = r • D :=
  rfl
#align derivation.coe_smul Derivation.coe_smul

@[simp]
theorem coe_smul_linearMap (r : S) (D : Derivation R A M) : ↑(r • D) = (r • D : A →ₗ[R] M) :=
  rfl
#align derivation.coe_smul_linear_map Derivation.coe_smul_linearMap

theorem smul_apply (r : S) (D : Derivation R A M) : (r • D) a = r • D a :=
  rfl
#align derivation.smul_apply Derivation.smul_apply

instance : AddCommMonoid (Derivation R A M) :=
  coe_injective.AddCommMonoid _ coe_zero coe_add fun _ _ => rfl

/-- `coe_fn` as an `add_monoid_hom`. -/
def coeFnAddMonoidHom : Derivation R A M →+ A → M
    where
  toFun := coeFn
  map_zero' := coe_zero
  map_add' := coe_add
#align derivation.coe_fn_add_monoid_hom Derivation.coeFnAddMonoidHom

instance (priority := 100) : DistribMulAction S (Derivation R A M) :=
  Function.Injective.distribMulAction coeFnAddMonoidHom coe_injective coe_smul

instance [DistribMulAction Sᵐᵒᵖ M] [IsCentralScalar S M] : IsCentralScalar S (Derivation R A M)
    where op_smul_eq_smul _ _ := ext fun _ => op_smul_eq_smul _ _

end Scalar

instance (priority := 100) {S : Type _} [Semiring S] [Module S M] [SMulCommClass R S M]
    [SMulCommClass S A M] : Module S (Derivation R A M) :=
  Function.Injective.module S coeFnAddMonoidHom coe_injective coe_smul

instance [IsScalarTower R A M] : IsScalarTower R A (Derivation R A M) :=
  ⟨fun x y z => ext fun a => smul_assoc _ _ _⟩

section PushForward

variable {N : Type _} [AddCommMonoid N] [Module A N] [Module R N] [IsScalarTower R A M]
  [IsScalarTower R A N]

variable (f : M →ₗ[A] N) (e : M ≃ₗ[A] N)

/-- We can push forward derivations using linear maps, i.e., the composition of a derivation with a
linear map is a derivation. Furthermore, this operation is linear on the spaces of derivations. -/
def LinearMap.compDer : Derivation R A M →ₗ[R] Derivation R A N
    where
  toFun D :=
    { toLinearMap := (f : M →ₗ[R] N).comp (D : A →ₗ[R] M)
      map_one_eq_zero' := by simp only [LinearMap.comp_apply, coe_fn_coe, map_one_eq_zero, map_zero]
      leibniz' := fun a b => by
        simp only [coe_fn_coe, LinearMap.comp_apply, LinearMap.map_add, leibniz,
          LinearMap.coe_restrictScalars, LinearMap.map_smul] }
  map_add' D₁ D₂ := by
    ext
    exact LinearMap.map_add _ _ _
  map_smul' r D := by
    ext
    exact LinearMap.map_smul _ _ _
#align linear_map.comp_der LinearMap.compDer

@[simp]
theorem coe_to_linearMap_comp : (f.compDer D : A →ₗ[R] N) = (f : M →ₗ[R] N).comp (D : A →ₗ[R] M) :=
  rfl
#align derivation.coe_to_linear_map_comp Derivation.coe_to_linearMap_comp

@[simp]
theorem coe_comp : (f.compDer D : A → N) = (f : M →ₗ[R] N).comp (D : A →ₗ[R] M) :=
  rfl
#align derivation.coe_comp Derivation.coe_comp

/-- The composition of a derivation with a linear map as a bilinear map -/
@[simps]
def llcomp : (M →ₗ[A] N) →ₗ[A] Derivation R A M →ₗ[R] Derivation R A N
    where
  toFun f := f.compDer
  map_add' f₁ f₂ := by
    ext
    rfl
  map_smul' r D := by
    ext
    rfl
#align derivation.llcomp Derivation.llcomp

/-- Pushing a derivation foward through a linear equivalence is an equivalence. -/
def LinearEquiv.compDer : Derivation R A M ≃ₗ[R] Derivation R A N :=
  { e.toLinearMap.compDer with
    invFun := e.symm.toLinearMap.compDer
    left_inv := fun D => by
      ext a
      exact e.symm_apply_apply (D a)
    right_inv := fun D => by
      ext a
      exact e.apply_symm_apply (D a) }
#align linear_equiv.comp_der LinearEquiv.compDer

end PushForward

section RestrictScalars

variable {S : Type _} [CommSemiring S]

variable [Algebra S A] [Module S M] [LinearMap.CompatibleSMul A M R S]

variable (R)

/-- If `A` is both an `R`-algebra and an `S`-algebra; `M` is both an `R`-module and an `S`-module,
then an `S`-derivation `A → M` is also an `R`-derivation if it is also `R`-linear. -/
protected def restrictScalars (d : Derivation S A M) : Derivation R A M
    where
  map_one_eq_zero' := d.map_one_eq_zero
  leibniz' := d.leibniz
  toLinearMap := d.toLinearMap.restrictScalars R
#align derivation.restrict_scalars Derivation.restrictScalars

end RestrictScalars

end

section Cancel

variable {R : Type _} [CommSemiring R] {A : Type _} [CommSemiring A] [Algebra R A] {M : Type _}
  [AddCancelCommMonoid M] [Module R M] [Module A M]

/-- Define `derivation R A M` from a linear map when `M` is cancellative by verifying the Leibniz
rule. -/
def mk' (D : A →ₗ[R] M) (h : ∀ a b, D (a * b) = a • D b + b • D a) : Derivation R A M
    where
  toLinearMap := D
  map_one_eq_zero' := add_right_eq_self.1 <| by simpa only [one_smul, one_mul] using (h 1 1).symm
  leibniz' := h
#align derivation.mk' Derivation.mk'

@[simp]
theorem coe_mk' (D : A →ₗ[R] M) (h) : ⇑(mk' D h) = D :=
  rfl
#align derivation.coe_mk' Derivation.coe_mk'

@[simp]
theorem coe_mk'_linearMap (D : A →ₗ[R] M) (h) : (mk' D h : A →ₗ[R] M) = D :=
  rfl
#align derivation.coe_mk'_linear_map Derivation.coe_mk'_linearMap

end Cancel

section

variable {R : Type _} [CommRing R]

variable {A : Type _} [CommRing A] [Algebra R A]

section

variable {M : Type _} [AddCommGroup M] [Module A M] [Module R M]

variable (D : Derivation R A M) {D1 D2 : Derivation R A M} (r : R) (a b : A)

protected theorem map_neg : D (-a) = -D a :=
  map_neg D a
#align derivation.map_neg Derivation.map_neg

protected theorem map_sub : D (a - b) = D a - D b :=
  map_sub D a b
#align derivation.map_sub Derivation.map_sub

@[simp]
theorem map_coe_int (n : ℤ) : D (n : A) = 0 := by
  rw [← zsmul_one, D.map_smul_of_tower n, map_one_eq_zero, smul_zero]
#align derivation.map_coe_int Derivation.map_coe_int

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

#align derivation.leibniz_of_mul_eq_one Derivation.leibniz_of_mul_eq_one

theorem leibniz_invOf [Invertible a] : D (⅟ a) = -⅟ a ^ 2 • D a :=
  D.leibniz_of_mul_eq_one <| invOf_mul_self a
#align derivation.leibniz_inv_of Derivation.leibniz_invOf

theorem leibniz_inv {K : Type _} [Field K] [Module K M] [Algebra R K] (D : Derivation R K M)
    (a : K) : D a⁻¹ = -a⁻¹ ^ 2 • D a :=
  by
  rcases eq_or_ne a 0 with (rfl | ha)
  · simp
  · exact D.leibniz_of_mul_eq_one (inv_mul_cancel ha)
#align derivation.leibniz_inv Derivation.leibniz_inv

instance : Neg (Derivation R A M) :=
  ⟨fun D =>
    mk' (-D) fun a b => by
      simp only [LinearMap.neg_apply, smul_neg, neg_add_rev, leibniz, coe_fn_coe, add_comm]⟩

@[simp]
theorem coe_neg (D : Derivation R A M) : ⇑(-D) = -D :=
  rfl
#align derivation.coe_neg Derivation.coe_neg

@[simp]
theorem coe_neg_linearMap (D : Derivation R A M) : ↑(-D) = (-D : A →ₗ[R] M) :=
  rfl
#align derivation.coe_neg_linear_map Derivation.coe_neg_linearMap

theorem neg_apply : (-D) a = -D a :=
  rfl
#align derivation.neg_apply Derivation.neg_apply

instance : Sub (Derivation R A M) :=
  ⟨fun D1 D2 =>
    mk' (D1 - D2 : A →ₗ[R] M) fun a b => by
      simp only [LinearMap.sub_apply, leibniz, coe_fn_coe, smul_sub, add_sub_add_comm]⟩

@[simp]
theorem coe_sub (D1 D2 : Derivation R A M) : ⇑(D1 - D2) = D1 - D2 :=
  rfl
#align derivation.coe_sub Derivation.coe_sub

@[simp]
theorem coe_sub_linearMap (D1 D2 : Derivation R A M) : ↑(D1 - D2) = (D1 - D2 : A →ₗ[R] M) :=
  rfl
#align derivation.coe_sub_linear_map Derivation.coe_sub_linearMap

theorem sub_apply : (D1 - D2) a = D1 a - D2 a :=
  rfl
#align derivation.sub_apply Derivation.sub_apply

instance : AddCommGroup (Derivation R A M) :=
  coe_injective.AddCommGroup _ coe_zero coe_add coe_neg coe_sub (fun _ _ => rfl) fun _ _ => rfl

end

section LieStructures

/-! # Lie structures -/

variable (D : Derivation R A A) {D1 D2 : Derivation R A A} (r : R) (a b : A)

/-- The commutator of derivations is again a derivation. -/
instance : Bracket (Derivation R A A) (Derivation R A A) :=
  ⟨fun D1 D2 =>
    mk' ⁅(D1 : Module.End R A), (D2 : Module.End R A)⁆ fun a b =>
      by
      simp only [Ring.lie_def, map_add, id.smul_eq_mul, LinearMap.mul_apply, leibniz, coe_fn_coe,
        LinearMap.sub_apply]
      ring⟩

@[simp]
theorem commutator_coe_linear_map : ↑⁅D1, D2⁆ = ⁅(D1 : Module.End R A), (D2 : Module.End R A)⁆ :=
  rfl
#align derivation.commutator_coe_linear_map Derivation.commutator_coe_linear_map

theorem commutator_apply : ⁅D1, D2⁆ a = D1 (D2 a) - D2 (D1 a) :=
  rfl
#align derivation.commutator_apply Derivation.commutator_apply

instance : LieRing (Derivation R A A)
    where
  add_lie d e f := by
    ext a
    simp only [commutator_apply, add_apply, map_add]
    ring
  lie_add d e f := by
    ext a
    simp only [commutator_apply, add_apply, map_add]
    ring
  lie_self d := by
    ext a
    simp only [commutator_apply, add_apply, map_add]
    ring_nf
  leibniz_lie d e f := by
    ext a
    simp only [commutator_apply, add_apply, sub_apply, map_sub]
    ring

instance : LieAlgebra R (Derivation R A A) :=
  { Derivation.module with
    lie_smul := fun r d e => by
      ext a
      simp only [commutator_apply, map_smul, smul_sub, smul_apply] }

end LieStructures

end

end Derivation

section ToSquareZero

universe u v w

variable {R : Type u} {A : Type v} {B : Type w} [CommSemiring R] [CommSemiring A] [CommRing B]

variable [Algebra R A] [Algebra R B] (I : Ideal B) (hI : I ^ 2 = ⊥)

/-- If `f₁ f₂ : A →ₐ[R] B` are two lifts of the same `A →ₐ[R] B ⧸ I`,
  we may define a map `f₁ - f₂ : A →ₗ[R] I`. -/
def diffToIdealOfQuotientCompEq (f₁ f₂ : A →ₐ[R] B)
    (e : (Ideal.Quotient.mkₐ R I).comp f₁ = (Ideal.Quotient.mkₐ R I).comp f₂) : A →ₗ[R] I :=
  LinearMap.codRestrict (I.restrictScalars _) (f₁.toLinearMap - f₂.toLinearMap)
    (by
      intro x
      change f₁ x - f₂ x ∈ I
      rw [← Ideal.Quotient.eq, ← Ideal.Quotient.mkₐ_eq_mk R, ← AlgHom.comp_apply, e]
      rfl)
#align diff_to_ideal_of_quotient_comp_eq diffToIdealOfQuotientCompEq

@[simp]
theorem diffToIdealOfQuotientCompEq_apply (f₁ f₂ : A →ₐ[R] B)
    (e : (Ideal.Quotient.mkₐ R I).comp f₁ = (Ideal.Quotient.mkₐ R I).comp f₂) (x : A) :
    ((diffToIdealOfQuotientCompEq I f₁ f₂ e) x : B) = f₁ x - f₂ x :=
  rfl
#align diff_to_ideal_of_quotient_comp_eq_apply diffToIdealOfQuotientCompEq_apply

variable [Algebra A B] [IsScalarTower R A B]

include hI

/-- Given a tower of algebras `R → A → B`, and a square-zero `I : ideal B`, each lift `A →ₐ[R] B`
of the canonical map `A →ₐ[R] B ⧸ I` corresponds to a `R`-derivation from `A` to `I`. -/
def derivationToSquareZeroOfLift (f : A →ₐ[R] B)
    (e : (Ideal.Quotient.mkₐ R I).comp f = IsScalarTower.toAlgHom R A (B ⧸ I)) : Derivation R A I :=
  by
  refine'
    {
      diffToIdealOfQuotientCompEq I f (IsScalarTower.toAlgHom R A B)
        _ with
      map_one_eq_zero' := _
      leibniz' := _ }
  · rw [e]
    ext
    rfl
  · ext
    change f 1 - algebraMap A B 1 = 0
    rw [map_one, map_one, sub_self]
  · intro x y
    let F :=
      diffToIdealOfQuotientCompEq I f (IsScalarTower.toAlgHom R A B)
        (by
          rw [e]
          ext
          rfl)
    have : (f x - algebraMap A B x) * (f y - algebraMap A B y) = 0 :=
      by
      rw [← Ideal.mem_bot, ← hI, pow_two]
      convert Ideal.mul_mem_mul (F x).2 (F y).2 using 1
    ext
    dsimp only [Submodule.coe_add, Submodule.coe_mk, LinearMap.coe_mk,
      diffToIdealOfQuotientCompEq_apply, Submodule.coe_smul_of_tower, IsScalarTower.coe_to_alg_hom',
      LinearMap.toFun_eq_coe]
    simp only [map_mul, sub_mul, mul_sub, Algebra.smul_def] at this⊢
    rw [sub_eq_iff_eq_add, sub_eq_iff_eq_add] at this
    rw [this]
    ring
#align derivation_to_square_zero_of_lift derivationToSquareZeroOfLift

theorem derivationToSquareZeroOfLift_apply (f : A →ₐ[R] B)
    (e : (Ideal.Quotient.mkₐ R I).comp f = IsScalarTower.toAlgHom R A (B ⧸ I)) (x : A) :
    (derivationToSquareZeroOfLift I hI f e x : B) = f x - algebraMap A B x :=
  rfl
#align derivation_to_square_zero_of_lift_apply derivationToSquareZeroOfLift_apply

/-- Given a tower of algebras `R → A → B`, and a square-zero `I : ideal B`, each `R`-derivation
from `A` to `I` corresponds to a lift `A →ₐ[R] B` of the canonical map `A →ₐ[R] B ⧸ I`. -/
@[simps (config := { attrs := [] })]
def liftOfDerivationToSquareZero (f : Derivation R A I) : A →ₐ[R] B :=
  {
    ((I.restrictScalars R).Subtype.comp f.toLinearMap + (IsScalarTower.toAlgHom R A B).toLinearMap :
      A →ₗ[R] B) with
    toFun := fun x => f x + algebraMap A B x
    map_one' := by rw [map_one, f.map_one_eq_zero, Submodule.coe_zero, zero_add]
    map_mul' := fun x y =>
      by
      have : (f x : B) * f y = 0 :=
        by
        rw [← Ideal.mem_bot, ← hI, pow_two]
        convert Ideal.mul_mem_mul (f x).2 (f y).2 using 1
      simp only [map_mul, f.leibniz, add_mul, mul_add, Submodule.coe_add,
        Submodule.coe_smul_of_tower, Algebra.smul_def, this]
      ring
    commutes' := fun r => by
      simp only [Derivation.map_algebraMap, eq_self_iff_true, zero_add, Submodule.coe_zero, ←
        IsScalarTower.algebraMap_apply R A B r]
    map_zero' :=
      ((I.restrictScalars R).Subtype.comp f.toLinearMap +
          (IsScalarTower.toAlgHom R A B).toLinearMap).map_zero }
#align lift_of_derivation_to_square_zero liftOfDerivationToSquareZero

@[simp]
theorem liftOfDerivationToSquareZero_mk_apply (d : Derivation R A I) (x : A) :
    Ideal.Quotient.mk I (liftOfDerivationToSquareZero I hI d x) = algebraMap A (B ⧸ I) x :=
  by
  rw [liftOfDerivationToSquareZero_apply, map_add, ideal.quotient.eq_zero_iff_mem.mpr (d x).Prop,
    zero_add]
  rfl
#align lift_of_derivation_to_square_zero_mk_apply liftOfDerivationToSquareZero_mk_apply

/-- Given a tower of algebras `R → A → B`, and a square-zero `I : ideal B`,
there is a 1-1 correspondance between `R`-derivations from `A` to `I` and
lifts `A →ₐ[R] B` of the canonical map `A →ₐ[R] B ⧸ I`. -/
@[simps]
def derivationToSquareZeroEquivLift :
    Derivation R A I ≃
      { f : A →ₐ[R] B // (Ideal.Quotient.mkₐ R I).comp f = IsScalarTower.toAlgHom R A (B ⧸ I) } :=
  by
  refine'
    ⟨fun d => ⟨liftOfDerivationToSquareZero I hI d, _⟩, fun f =>
      (derivationToSquareZeroOfLift I hI f.1 f.2 : _), _, _⟩
  · ext x
    exact liftOfDerivationToSquareZero_mk_apply I hI d x
  · intro d
    ext x
    exact add_sub_cancel (d x : B) (algebraMap A B x)
  · rintro ⟨f, hf⟩
    ext x
    exact sub_add_cancel (f x) (algebraMap A B x)
#align derivation_to_square_zero_equiv_lift derivationToSquareZeroEquivLift

end ToSquareZero

section KaehlerDifferential

open TensorProduct

variable (R S : Type _) [CommRing R] [CommRing S] [Algebra R S]

/-- The kernel of the multiplication map `S ⊗[R] S →ₐ[R] S`. -/
abbrev KaehlerDifferential.ideal : Ideal (S ⊗[R] S) :=
  RingHom.ker (TensorProduct.lmul' R : S ⊗[R] S →ₐ[R] S)
#align kaehler_differential.ideal KaehlerDifferential.ideal

variable {S}

theorem KaehlerDifferential.one_smul_sub_smul_one_mem_ideal (a : S) :
    (1 : S) ⊗ₜ[R] a - a ⊗ₜ[R] (1 : S) ∈ KaehlerDifferential.ideal R S := by simp [RingHom.mem_ker]
#align kaehler_differential.one_smul_sub_smul_one_mem_ideal KaehlerDifferential.one_smul_sub_smul_one_mem_ideal

variable {R}

variable {M : Type _} [AddCommGroup M] [Module R M] [Module S M] [IsScalarTower R S M]

/-- For a `R`-derivation `S → M`, this is the map `S ⊗[R] S →ₗ[S] M` sending `s ⊗ₜ t ↦ s • D t`. -/
def Derivation.tensorProductTo (D : Derivation R S M) : S ⊗[R] S →ₗ[S] M :=
  TensorProduct.AlgebraTensorModule.lift ((LinearMap.lsmul S (S →ₗ[R] M)).flip D.toLinearMap)
#align derivation.tensor_product_to Derivation.tensorProductTo

theorem Derivation.tensorProductTo_tmul (D : Derivation R S M) (s t : S) :
    D.tensorProductTo (s ⊗ₜ t) = s • D t :=
  rfl
#align derivation.tensor_product_to_tmul Derivation.tensorProductTo_tmul

theorem Derivation.tensorProductTo_mul (D : Derivation R S M) (x y : S ⊗[R] S) :
    D.tensorProductTo (x * y) =
      TensorProduct.lmul' R x • D.tensorProductTo y +
        TensorProduct.lmul' R y • D.tensorProductTo x :=
  by
  apply TensorProduct.induction_on x
  · rw [MulZeroClass.zero_mul, map_zero, map_zero, zero_smul, smul_zero, add_zero]
  swap;
  · rintro
    simp only [add_mul, map_add, add_smul, *, smul_add]
    rw [add_add_add_comm]
  intro x₁ x₂
  apply TensorProduct.induction_on y
  · rw [MulZeroClass.mul_zero, map_zero, map_zero, zero_smul, smul_zero, add_zero]
  swap;
  · rintro
    simp only [mul_add, map_add, add_smul, *, smul_add]
    rw [add_add_add_comm]
  intro x y
  simp only [tensor_product.tmul_mul_tmul, Derivation.tensorProductTo,
    TensorProduct.AlgebraTensorModule.lift_apply, TensorProduct.lift.tmul',
    tensor_product.lmul'_apply_tmul]
  dsimp
  rw [D.leibniz]
  simp only [smul_smul, smul_add, mul_comm (x * y) x₁, mul_right_comm x₁ x₂, ← mul_assoc]
#align derivation.tensor_product_to_mul Derivation.tensorProductTo_mul

variable (R S)

/-- The kernel of `S ⊗[R] S →ₐ[R] S` is generated by `1 ⊗ s - s ⊗ 1` as a `S`-module. -/
theorem KaehlerDifferential.submodule_span_range_eq_ideal :
    Submodule.span S (Set.range fun s : S => (1 : S) ⊗ₜ[R] s - s ⊗ₜ[R] (1 : S)) =
      (KaehlerDifferential.ideal R S).restrictScalars S :=
  by
  apply le_antisymm
  · rw [Submodule.span_le]
    rintro _ ⟨s, rfl⟩
    exact KaehlerDifferential.one_smul_sub_smul_one_mem_ideal _ _
  · rintro x (hx : _ = _)
    have : x - tensor_product.lmul' R x ⊗ₜ[R] (1 : S) = x := by
      rw [hx, TensorProduct.zero_tmul, sub_zero]
    rw [← this]
    clear this hx
    apply TensorProduct.induction_on x <;> clear x
    · rw [map_zero, TensorProduct.zero_tmul, sub_zero]
      exact zero_mem _
    · intro x y
      convert_to x • (1 ⊗ₜ y - y ⊗ₜ 1) ∈ _
      ·
        rw [tensor_product.lmul'_apply_tmul, smul_sub, TensorProduct.smul_tmul',
          TensorProduct.smul_tmul', smul_eq_mul, smul_eq_mul, mul_one]
      · refine' Submodule.smul_mem _ x _
        apply Submodule.subset_span
        exact Set.mem_range_self y
    · intro x y hx hy
      rw [map_add, TensorProduct.add_tmul, ← sub_add_sub_comm]
      exact add_mem hx hy
#align kaehler_differential.submodule_span_range_eq_ideal KaehlerDifferential.submodule_span_range_eq_ideal

theorem KaehlerDifferential.span_range_eq_ideal :
    Ideal.span (Set.range fun s : S => (1 : S) ⊗ₜ[R] s - s ⊗ₜ[R] (1 : S)) =
      KaehlerDifferential.ideal R S :=
  by
  apply le_antisymm
  · rw [Ideal.span_le]
    rintro _ ⟨s, rfl⟩
    exact KaehlerDifferential.one_smul_sub_smul_one_mem_ideal _ _
  · change (KaehlerDifferential.ideal R S).restrictScalars S ≤ (Ideal.span _).restrictScalars S
    rw [← KaehlerDifferential.submodule_span_range_eq_ideal, Ideal.span]
    conv_rhs => rw [← Submodule.span_span_of_tower S]
    exact Submodule.subset_span
#align kaehler_differential.span_range_eq_ideal KaehlerDifferential.span_range_eq_ideal

/- ./././Mathport/Syntax/Translate/Command.lean:42:9: unsupported derive handler module[module] tensor_product(S, R, S) -/
/-- The module of Kähler differentials (Kahler differentials, Kaehler differentials).
This is implemented as `I / I ^ 2` with `I` the kernel of the multiplication map `S ⊗[R] S →ₐ[R] S`.
To view elements as a linear combination of the form `s • D s'`, use
`kaehler_differential.tensor_product_to_surjective` and `derivation.tensor_product_to_tmul`.

We also provide the notation `Ω[S⁄R]` for `kaehler_differential R S`.
Note that the slash is `\textfractionsolidus`.
-/
def KaehlerDifferential : Type _ :=
  (KaehlerDifferential.ideal R S).Cotangent deriving AddCommGroup,
  «./././Mathport/Syntax/Translate/Command.lean:42:9: unsupported derive handler module[module] tensor_product(S, R, S)»
#align kaehler_differential KaehlerDifferential

-- mathport name: «exprΩ[ ⁄ ]»
notation:100 "Ω[" S "⁄" R "]" => KaehlerDifferential R S

instance : Nonempty (Ω[S⁄R]) :=
  ⟨0⟩

instance KaehlerDifferential.module' {R' : Type _} [CommRing R'] [Algebra R' S] :
    Module R' (Ω[S⁄R]) :=
  (Module.compHom (KaehlerDifferential.ideal R S).Cotangent (algebraMap R' S) : _)
#align kaehler_differential.module' KaehlerDifferential.module'

instance : IsScalarTower S (S ⊗[R] S) (Ω[S⁄R]) :=
  Ideal.Cotangent.isScalarTower _

instance KaehlerDifferential.isScalarTower_of_tower {R₁ R₂ : Type _} [CommRing R₁] [CommRing R₂]
    [Algebra R₁ S] [Algebra R₂ S] [Algebra R₁ R₂] [IsScalarTower R₁ R₂ S] :
    IsScalarTower R₁ R₂ (Ω[S⁄R]) :=
  by
  convert RestrictScalars.isScalarTower R₁ R₂ (Ω[S⁄R]) using 1
  ext (x m)
  show algebraMap R₁ S x • m = algebraMap R₂ S (algebraMap R₁ R₂ x) • m
  rw [← IsScalarTower.algebraMap_apply]
#align kaehler_differential.is_scalar_tower_of_tower KaehlerDifferential.isScalarTower_of_tower

instance KaehlerDifferential.is_scalar_tower' : IsScalarTower R (S ⊗[R] S) (Ω[S⁄R]) :=
  by
  convert RestrictScalars.isScalarTower R (S ⊗[R] S) (Ω[S⁄R]) using 1
  ext (x m)
  show algebraMap R S x • m = algebraMap R (S ⊗[R] S) x • m
  simp_rw [IsScalarTower.algebraMap_apply R S (S ⊗[R] S), IsScalarTower.algebraMap_smul]
#align kaehler_differential.is_scalar_tower' KaehlerDifferential.is_scalar_tower'

/-- The quotient map `I → Ω[S⁄R]` with `I` being the kernel of `S ⊗[R] S → S`. -/
def KaehlerDifferential.fromIdeal : KaehlerDifferential.ideal R S →ₗ[S ⊗[R] S] Ω[S⁄R] :=
  (KaehlerDifferential.ideal R S).toCotangent
#align kaehler_differential.from_ideal KaehlerDifferential.fromIdeal

/-- (Implementation) The underlying linear map of the derivation into `Ω[S⁄R]`. -/
def KaehlerDifferential.dLinearMap : S →ₗ[R] Ω[S⁄R] :=
  ((KaehlerDifferential.fromIdeal R S).restrictScalars R).comp
    ((TensorProduct.includeRight.toLinearMap - TensorProduct.includeLeft.toLinearMap :
            S →ₗ[R] S ⊗[R] S).codRestrict
        ((KaehlerDifferential.ideal R S).restrictScalars R)
        (KaehlerDifferential.one_smul_sub_smul_one_mem_ideal R) :
      _ →ₗ[R] _)
#align kaehler_differential.D_linear_map KaehlerDifferential.dLinearMap

theorem KaehlerDifferential.dLinearMap_apply (s : S) :
    KaehlerDifferential.dLinearMap R S s =
      (KaehlerDifferential.ideal R S).toCotangent
        ⟨1 ⊗ₜ s - s ⊗ₜ 1, KaehlerDifferential.one_smul_sub_smul_one_mem_ideal R s⟩ :=
  rfl
#align kaehler_differential.D_linear_map_apply KaehlerDifferential.dLinearMap_apply

/-- The universal derivation into `Ω[S⁄R]`. -/
def KaehlerDifferential.d : Derivation R S (Ω[S⁄R]) :=
  {
    KaehlerDifferential.dLinearMap R
      S with
    map_one_eq_zero' := by
      dsimp [KaehlerDifferential.dLinearMap_apply]
      rw [Ideal.toCotangent_eq_zero, Subtype.coe_mk, sub_self]
      exact zero_mem _
    leibniz' := fun a b => by
      dsimp [KaehlerDifferential.dLinearMap_apply]
      rw [← LinearMap.map_smul_of_tower, ← LinearMap.map_smul_of_tower, ← map_add,
        Ideal.toCotangent_eq, pow_two]
      convert Submodule.mul_mem_mul (KaehlerDifferential.one_smul_sub_smul_one_mem_ideal R a : _)
          (KaehlerDifferential.one_smul_sub_smul_one_mem_ideal R b : _) using
        1
      simp only [AddSubgroupClass.coe_sub, Submodule.coe_add, Submodule.coe_mk,
        tensor_product.tmul_mul_tmul, mul_sub, sub_mul, mul_comm b, Submodule.coe_smul_of_tower,
        smul_sub, TensorProduct.smul_tmul', smul_eq_mul, mul_one]
      ring_nf }
#align kaehler_differential.D KaehlerDifferential.d

theorem KaehlerDifferential.d_apply (s : S) :
    KaehlerDifferential.d R S s =
      (KaehlerDifferential.ideal R S).toCotangent
        ⟨1 ⊗ₜ s - s ⊗ₜ 1, KaehlerDifferential.one_smul_sub_smul_one_mem_ideal R s⟩ :=
  rfl
#align kaehler_differential.D_apply KaehlerDifferential.d_apply

theorem KaehlerDifferential.span_range_derivation :
    Submodule.span S (Set.range <| KaehlerDifferential.d R S) = ⊤ :=
  by
  rw [_root_.eq_top_iff]
  rintro x -
  obtain ⟨⟨x, hx⟩, rfl⟩ := Ideal.toCotangent_surjective _ x
  have : x ∈ (KaehlerDifferential.ideal R S).restrictScalars S := hx
  rw [← KaehlerDifferential.submodule_span_range_eq_ideal] at this
  suffices
    ∃ hx,
      (KaehlerDifferential.ideal R S).toCotangent ⟨x, hx⟩ ∈
        Submodule.span S (Set.range <| KaehlerDifferential.d R S)
    by exact this.some_spec
  apply Submodule.span_induction this
  · rintro _ ⟨x, rfl⟩
    refine' ⟨KaehlerDifferential.one_smul_sub_smul_one_mem_ideal R x, _⟩
    apply Submodule.subset_span
    exact ⟨x, KaehlerDifferential.dLinearMap_apply R S x⟩
  · exact ⟨zero_mem _, Submodule.zero_mem _⟩
  · rintro x y ⟨hx₁, hx₂⟩ ⟨hy₁, hy₂⟩
    exact ⟨add_mem hx₁ hy₁, Submodule.add_mem _ hx₂ hy₂⟩
  · rintro r x ⟨hx₁, hx₂⟩
    exact
      ⟨((KaehlerDifferential.ideal R S).restrictScalars S).smul_mem r hx₁,
        Submodule.smul_mem _ r hx₂⟩
#align kaehler_differential.span_range_derivation KaehlerDifferential.span_range_derivation

variable {R S}

/-- The linear map from `Ω[S⁄R]`, associated with a derivation. -/
def Derivation.liftKaehlerDifferential (D : Derivation R S M) : Ω[S⁄R] →ₗ[S] M :=
  by
  refine'
    ((KaehlerDifferential.ideal R S • ⊤ :
              Submodule (S ⊗[R] S) (KaehlerDifferential.ideal R S)).restrictScalars
          S).liftQ
      _ _
  · exact D.tensor_product_to.comp ((KaehlerDifferential.ideal R S).Subtype.restrictScalars S)
  · intro x hx
    change _ = _
    apply Submodule.smul_induction_on hx <;> clear hx x
    · rintro x (hx : _ = _) ⟨y, hy : _ = _⟩ -
      dsimp
      rw [Derivation.tensorProductTo_mul, hx, hy, zero_smul, zero_smul, zero_add]
    · intro x y ex ey
      rw [map_add, ex, ey, zero_add]
#align derivation.lift_kaehler_differential Derivation.liftKaehlerDifferential

theorem Derivation.liftKaehlerDifferential_apply (D : Derivation R S M) (x) :
    D.liftKaehlerDifferential ((KaehlerDifferential.ideal R S).toCotangent x) =
      D.tensorProductTo x :=
  rfl
#align derivation.lift_kaehler_differential_apply Derivation.liftKaehlerDifferential_apply

theorem Derivation.liftKaehlerDifferential_comp (D : Derivation R S M) :
    D.liftKaehlerDifferential.compDer (KaehlerDifferential.d R S) = D :=
  by
  ext a
  dsimp [KaehlerDifferential.d_apply]
  refine' (D.lift_kaehler_differential_apply _).trans _
  rw [Subtype.coe_mk, map_sub, Derivation.tensorProductTo_tmul, Derivation.tensorProductTo_tmul,
    one_smul, D.map_one_eq_zero, smul_zero, sub_zero]
#align derivation.lift_kaehler_differential_comp Derivation.liftKaehlerDifferential_comp

@[simp]
theorem Derivation.liftKaehlerDifferential_comp_d (D' : Derivation R S M) (x : S) :
    D'.liftKaehlerDifferential (KaehlerDifferential.d R S x) = D' x :=
  Derivation.congr_fun D'.liftKaehlerDifferential_comp x
#align derivation.lift_kaehler_differential_comp_D Derivation.liftKaehlerDifferential_comp_d

@[ext]
theorem Derivation.lift_kaehlerDifferential_unique (f f' : Ω[S⁄R] →ₗ[S] M)
    (hf : f.compDer (KaehlerDifferential.d R S) = f'.compDer (KaehlerDifferential.d R S)) :
    f = f' := by
  apply LinearMap.ext
  intro x
  have : x ∈ Submodule.span S (Set.range <| KaehlerDifferential.d R S) :=
    by
    rw [KaehlerDifferential.span_range_derivation]
    trivial
  apply Submodule.span_induction this
  · rintro _ ⟨x, rfl⟩
    exact congr_arg (fun D : Derivation R S M => D x) hf
  · rw [map_zero, map_zero]
  · intro x y hx hy
    rw [map_add, map_add, hx, hy]
  · intro a x e
    rw [map_smul, map_smul, e]
#align derivation.lift_kaehler_differential_unique Derivation.lift_kaehlerDifferential_unique

variable (R S)

theorem Derivation.liftKaehlerDifferential_d :
    (KaehlerDifferential.d R S).liftKaehlerDifferential = LinearMap.id :=
  Derivation.lift_kaehlerDifferential_unique _ _
    (KaehlerDifferential.d R S).liftKaehlerDifferential_comp
#align derivation.lift_kaehler_differential_D Derivation.liftKaehlerDifferential_d

variable {R S}

theorem KaehlerDifferential.d_tensorProductTo (x : KaehlerDifferential.ideal R S) :
    (KaehlerDifferential.d R S).tensorProductTo x = (KaehlerDifferential.ideal R S).toCotangent x :=
  by
  rw [← Derivation.liftKaehlerDifferential_apply, Derivation.liftKaehlerDifferential_d]
  rfl
#align kaehler_differential.D_tensor_product_to KaehlerDifferential.d_tensorProductTo

variable (R S)

theorem KaehlerDifferential.tensorProductTo_surjective :
    Function.Surjective (KaehlerDifferential.d R S).tensorProductTo :=
  by
  intro x; obtain ⟨x, rfl⟩ := (KaehlerDifferential.ideal R S).toCotangent_surjective x
  exact ⟨x, KaehlerDifferential.d_tensorProductTo x⟩
#align kaehler_differential.tensor_product_to_surjective KaehlerDifferential.tensorProductTo_surjective

/-- The `S`-linear maps from `Ω[S⁄R]` to `M` are (`S`-linearly) equivalent to `R`-derivations
from `S` to `M`.  -/
def KaehlerDifferential.linearMapEquivDerivation : (Ω[S⁄R] →ₗ[S] M) ≃ₗ[S] Derivation R S M :=
  {
    Derivation.llcomp.flip <|
      KaehlerDifferential.d R
        S with
    invFun := Derivation.liftKaehlerDifferential
    left_inv := fun f =>
      Derivation.lift_kaehlerDifferential_unique _ _ (Derivation.liftKaehlerDifferential_comp _)
    right_inv := Derivation.liftKaehlerDifferential_comp }
#align kaehler_differential.linear_map_equiv_derivation KaehlerDifferential.linearMapEquivDerivation

/-- The quotient ring of `S ⊗ S ⧸ J ^ 2` by `Ω[S⁄R]` is isomorphic to `S`. -/
def KaehlerDifferential.quotientCotangentIdealRingEquiv :
    (S ⊗ S ⧸ KaehlerDifferential.ideal R S ^ 2) ⧸ (KaehlerDifferential.ideal R S).cotangentIdeal ≃+*
      S :=
  by
  have :
    Function.RightInverse tensor_product.include_left
      (↑(tensor_product.lmul' R : S ⊗[R] S →ₐ[R] S) : S ⊗[R] S →+* S) :=
    by
    intro x
    rw [AlgHom.coe_toRingHom, ← AlgHom.comp_apply, tensor_product.lmul'_comp_include_left]
    rfl
  refine' (Ideal.quotCotangent _).trans _
  refine' (Ideal.quotEquivOfEq _).trans (RingHom.quotientKerEquivOfRightInverse this)
  ext
  rfl
#align kaehler_differential.quotient_cotangent_ideal_ring_equiv KaehlerDifferential.quotientCotangentIdealRingEquiv

/-- The quotient ring of `S ⊗ S ⧸ J ^ 2` by `Ω[S⁄R]` is isomorphic to `S` as an `S`-algebra. -/
def KaehlerDifferential.quotientCotangentIdeal :
    ((S ⊗ S ⧸ KaehlerDifferential.ideal R S ^ 2) ⧸
        (KaehlerDifferential.ideal R S).cotangentIdeal) ≃ₐ[S]
      S :=
  { KaehlerDifferential.quotientCotangentIdealRingEquiv R S with
    commutes' := (KaehlerDifferential.quotientCotangentIdealRingEquiv R S).apply_symm_apply }
#align kaehler_differential.quotient_cotangent_ideal KaehlerDifferential.quotientCotangentIdeal

theorem KaehlerDifferential.End_equiv_aux (f : S →ₐ[R] S ⊗ S ⧸ KaehlerDifferential.ideal R S ^ 2) :
    (Ideal.Quotient.mkₐ R (KaehlerDifferential.ideal R S).cotangentIdeal).comp f =
        IsScalarTower.toAlgHom R S _ ↔
      (TensorProduct.lmul' R : S ⊗[R] S →ₐ[R] S).kerSquareLift.comp f = AlgHom.id R S :=
  by
  rw [AlgHom.ext_iff, AlgHom.ext_iff]
  apply forall_congr'
  intro x
  have e₁ :
    (tensor_product.lmul' R : S ⊗[R] S →ₐ[R] S).kerSquareLift (f x) =
      KaehlerDifferential.quotientCotangentIdealRingEquiv R S
        (Ideal.Quotient.mk (KaehlerDifferential.ideal R S).cotangentIdeal <| f x) :=
    by
    generalize f x = y
    obtain ⟨y, rfl⟩ := Ideal.Quotient.mk_surjective y
    rfl
  have e₂ :
    x = KaehlerDifferential.quotientCotangentIdealRingEquiv R S (IsScalarTower.toAlgHom R S _ x) :=
    (mul_one x).symm
  constructor
  · intro e
    exact
      (e₁.trans
            (@RingEquiv.congr_arg _ _ _ _ _ _
              (KaehlerDifferential.quotientCotangentIdealRingEquiv R S) _ _ e)).trans
        e₂.symm
  · intro e
    apply (KaehlerDifferential.quotientCotangentIdealRingEquiv R S).Injective
    exact e₁.symm.trans (e.trans e₂)
#align kaehler_differential.End_equiv_aux KaehlerDifferential.End_equiv_aux

-- This has type
-- `derivation R S Ω[ S / R ] ≃ₗ[R] derivation R S (kaehler_differential.ideal R S).cotangent_ideal`
-- But lean times-out if this is given explicitly.
/-- Derivations into `Ω[S⁄R]` is equivalent to derivations
into `(kaehler_differential.ideal R S).cotangent_ideal` -/
noncomputable def KaehlerDifferential.endEquivDerivation' :=
  @LinearEquiv.compDer R _ _ _ _ (Ω[S⁄R]) _ _ _ _ _ _ _ _ _
    ((KaehlerDifferential.ideal R S).cotangentEquivIdeal.restrictScalars S)
#align kaehler_differential.End_equiv_derivation' KaehlerDifferential.endEquivDerivation'

/-- (Implementation) An `equiv` version of `kaehler_differential.End_equiv_aux`.
Used in `kaehler_differential.End_equiv`. -/
def KaehlerDifferential.endEquivAuxEquiv :
    { f //
        (Ideal.Quotient.mkₐ R (KaehlerDifferential.ideal R S).cotangentIdeal).comp f =
          IsScalarTower.toAlgHom R S _ } ≃
      { f // (TensorProduct.lmul' R : S ⊗[R] S →ₐ[R] S).kerSquareLift.comp f = AlgHom.id R S } :=
  (Equiv.refl _).subtypeEquiv (KaehlerDifferential.End_equiv_aux R S)
#align kaehler_differential.End_equiv_aux_equiv KaehlerDifferential.endEquivAuxEquiv

/--
The endomorphisms of `Ω[S⁄R]` corresponds to sections of the surjection `S ⊗[R] S ⧸ J ^ 2 →ₐ[R] S`,
with `J` being the kernel of the multiplication map `S ⊗[R] S →ₐ[R] S`.
-/
noncomputable def KaehlerDifferential.endEquiv :
    Module.End S (Ω[S⁄R]) ≃
      { f // (TensorProduct.lmul' R : S ⊗[R] S →ₐ[R] S).kerSquareLift.comp f = AlgHom.id R S } :=
  (KaehlerDifferential.linearMapEquivDerivation R S).toEquiv.trans <|
    (KaehlerDifferential.endEquivDerivation' R S).toEquiv.trans <|
      (derivationToSquareZeroEquivLift (KaehlerDifferential.ideal R S).cotangentIdeal
            (KaehlerDifferential.ideal R S).cotangentIdeal_square).trans <|
        KaehlerDifferential.endEquivAuxEquiv R S
#align kaehler_differential.End_equiv KaehlerDifferential.endEquiv

section Presentation

open KaehlerDifferential (d)

open Finsupp (single)

/-- The `S`-submodule of `S →₀ S` (the direct sum of copies of `S` indexed by `S`) generated by
the relations:
1. `dx + dy = d(x + y)`
2. `x dy + y dx = d(x * y)`
3. `dr = 0` for `r ∈ R`
where `db` is the unit in the copy of `S` with index `b`.

This is the kernel of the surjection `finsupp.total S Ω[S⁄R] S (kaehler_differential.D R S)`.
See `kaehler_differential.ker_total_eq` and `kaehler_differential.total_surjective`.
-/
noncomputable def KaehlerDifferential.kerTotal : Submodule S (S →₀ S) :=
  Submodule.span S
    (((Set.range fun x : S × S => single x.1 1 + single x.2 1 - single (x.1 + x.2) 1) ∪
        Set.range fun x : S × S => single x.2 x.1 + single x.1 x.2 - single (x.1 * x.2) 1) ∪
      Set.range fun x : R => single (algebraMap R S x) 1)
#align kaehler_differential.ker_total KaehlerDifferential.kerTotal

-- mathport name: «expr 𝖣 »
local notation x "𝖣" y => (KaehlerDifferential.kerTotal R S).mkQ (single y x)

theorem KaehlerDifferential.kerTotal_mkQ_single_add (x y z) : (z𝖣x + y) = (z𝖣x) + z𝖣y :=
  by
  rw [← map_add, eq_comm, ← sub_eq_zero, ← map_sub, Submodule.mkQ_apply,
    Submodule.Quotient.mk_eq_zero]
  simp_rw [← Finsupp.smul_single_one _ z, ← smul_add, ← smul_sub]
  exact Submodule.smul_mem _ _ (Submodule.subset_span (Or.inl <| Or.inl <| ⟨⟨_, _⟩, rfl⟩))
#align kaehler_differential.ker_total_mkq_single_add KaehlerDifferential.kerTotal_mkQ_single_add

theorem KaehlerDifferential.kerTotal_mkQ_single_mul (x y z) : (z𝖣x * y) = ((z * x)𝖣y) + (z * y)𝖣x :=
  by
  rw [← map_add, eq_comm, ← sub_eq_zero, ← map_sub, Submodule.mkQ_apply,
    Submodule.Quotient.mk_eq_zero]
  simp_rw [← Finsupp.smul_single_one _ z, ← @smul_eq_mul _ _ z, ← Finsupp.smul_single, ← smul_add, ←
    smul_sub]
  exact Submodule.smul_mem _ _ (Submodule.subset_span (Or.inl <| Or.inr <| ⟨⟨_, _⟩, rfl⟩))
#align kaehler_differential.ker_total_mkq_single_mul KaehlerDifferential.kerTotal_mkQ_single_mul

theorem KaehlerDifferential.kerTotal_mkQ_single_algebraMap (x y) : (y𝖣algebraMap R S x) = 0 :=
  by
  rw [Submodule.mkQ_apply, Submodule.Quotient.mk_eq_zero, ← Finsupp.smul_single_one _ y]
  exact Submodule.smul_mem _ _ (Submodule.subset_span (Or.inr <| ⟨_, rfl⟩))
#align kaehler_differential.ker_total_mkq_single_algebra_map KaehlerDifferential.kerTotal_mkQ_single_algebraMap

theorem KaehlerDifferential.kerTotal_mkQ_single_algebra_map_one (x) : (x𝖣1) = 0 := by
  rw [← (algebraMap R S).map_one, KaehlerDifferential.kerTotal_mkQ_single_algebraMap]
#align kaehler_differential.ker_total_mkq_single_algebra_map_one KaehlerDifferential.kerTotal_mkQ_single_algebra_map_one

theorem KaehlerDifferential.kerTotal_mkQ_single_smul (r : R) (x y) : (y𝖣r • x) = r • y𝖣x := by
  rw [Algebra.smul_def, KaehlerDifferential.kerTotal_mkQ_single_mul,
    KaehlerDifferential.kerTotal_mkQ_single_algebraMap, add_zero, ← LinearMap.map_smul_of_tower,
    Finsupp.smul_single, mul_comm, Algebra.smul_def]
#align kaehler_differential.ker_total_mkq_single_smul KaehlerDifferential.kerTotal_mkQ_single_smul

/-- The (universal) derivation into `(S →₀ S) ⧸ kaehler_differential.ker_total R S`. -/
noncomputable def KaehlerDifferential.derivationQuotKerTotal :
    Derivation R S ((S →₀ S) ⧸ KaehlerDifferential.kerTotal R S)
    where
  toFun x := 1𝖣x
  map_add' x y := KaehlerDifferential.kerTotal_mkQ_single_add _ _ _ _ _
  map_smul' r s := KaehlerDifferential.kerTotal_mkQ_single_smul _ _ _ _ _
  map_one_eq_zero' := KaehlerDifferential.kerTotal_mkQ_single_algebra_map_one _ _ _
  leibniz' a b :=
    (KaehlerDifferential.kerTotal_mkQ_single_mul _ _ _ _ _).trans
      (by
        simp_rw [← Finsupp.smul_single_one _ (1 * _ : S)]
        dsimp
        simp)
#align kaehler_differential.derivation_quot_ker_total KaehlerDifferential.derivationQuotKerTotal

theorem KaehlerDifferential.derivationQuotKerTotal_apply (x) :
    KaehlerDifferential.derivationQuotKerTotal R S x = 1𝖣x :=
  rfl
#align kaehler_differential.derivation_quot_ker_total_apply KaehlerDifferential.derivationQuotKerTotal_apply

theorem KaehlerDifferential.derivationQuotKerTotal_lift_comp_total :
    (KaehlerDifferential.derivationQuotKerTotal R S).liftKaehlerDifferential.comp
        (Finsupp.total S (Ω[S⁄R]) S (KaehlerDifferential.d R S)) =
      Submodule.mkQ _ :=
  by
  apply Finsupp.lhom_ext
  intro a b
  conv_rhs => rw [← Finsupp.smul_single_one a b, LinearMap.map_smul]
  simp [KaehlerDifferential.derivationQuotKerTotal_apply]
#align kaehler_differential.derivation_quot_ker_total_lift_comp_total KaehlerDifferential.derivationQuotKerTotal_lift_comp_total

theorem KaehlerDifferential.kerTotal_eq :
    (Finsupp.total S (Ω[S⁄R]) S (KaehlerDifferential.d R S)).ker =
      KaehlerDifferential.kerTotal R S :=
  by
  apply le_antisymm
  · conv_rhs => rw [← (KaehlerDifferential.kerTotal R S).ker_mkQ]
    rw [← KaehlerDifferential.derivationQuotKerTotal_lift_comp_total]
    exact LinearMap.ker_le_ker_comp _ _
  · rw [KaehlerDifferential.kerTotal, Submodule.span_le]
    rintro _ ((⟨⟨x, y⟩, rfl⟩ | ⟨⟨x, y⟩, rfl⟩) | ⟨x, rfl⟩) <;> dsimp <;> simp [LinearMap.mem_ker]
#align kaehler_differential.ker_total_eq KaehlerDifferential.kerTotal_eq

theorem KaehlerDifferential.total_surjective :
    Function.Surjective (Finsupp.total S (Ω[S⁄R]) S (KaehlerDifferential.d R S)) := by
  rw [← LinearMap.range_eq_top, Finsupp.range_total, KaehlerDifferential.span_range_derivation]
#align kaehler_differential.total_surjective KaehlerDifferential.total_surjective

/-- `Ω[S⁄R]` is isomorphic to `S` copies of `S` with kernel `kaehler_differential.ker_total`. -/
@[simps]
noncomputable def KaehlerDifferential.quotKerTotalEquiv :
    ((S →₀ S) ⧸ KaehlerDifferential.kerTotal R S) ≃ₗ[S] Ω[S⁄R] :=
  {
    (KaehlerDifferential.kerTotal R S).liftQ
      (Finsupp.total S (Ω[S⁄R]) S (KaehlerDifferential.d R S))
      (KaehlerDifferential.kerTotal_eq R
          S).ge with
    invFun := (KaehlerDifferential.derivationQuotKerTotal R S).liftKaehlerDifferential
    left_inv := by
      intro x
      obtain ⟨x, rfl⟩ := Submodule.mkQ_surjective _ x
      exact
        LinearMap.congr_fun (KaehlerDifferential.derivationQuotKerTotal_lift_comp_total R S : _) x
    right_inv := by
      intro x
      obtain ⟨x, rfl⟩ := KaehlerDifferential.total_surjective R S x
      erw [LinearMap.congr_fun (KaehlerDifferential.derivationQuotKerTotal_lift_comp_total R S : _)
          x]
      rfl }
#align kaehler_differential.quot_ker_total_equiv KaehlerDifferential.quotKerTotalEquiv

theorem KaehlerDifferential.quotKerTotalEquiv_symm_comp_d :
    (KaehlerDifferential.quotKerTotalEquiv R S).symm.toLinearMap.compDer
        (KaehlerDifferential.d R S) =
      KaehlerDifferential.derivationQuotKerTotal R S :=
  by convert(KaehlerDifferential.derivationQuotKerTotal R S).liftKaehlerDifferential_comp using 0
#align kaehler_differential.quot_ker_total_equiv_symm_comp_D KaehlerDifferential.quotKerTotalEquiv_symm_comp_d

variable (A B : Type _) [CommRing A] [CommRing B] [Algebra R A] [Algebra S B] [Algebra R B]

variable [Algebra A B] [IsScalarTower R S B] [IsScalarTower R A B]

-- mathport name: exprfinsupp_map
-- The map `(A →₀ A) →ₗ[A] (B →₀ B)`
local notation "finsupp_map" =>
  (Finsupp.mapRange.linearMap (Algebra.ofId A B).toLinearMap).comp
    (Finsupp.lmapDomain A A (algebraMap A B))

theorem KaehlerDifferential.kerTotal_map (h : Function.Surjective (algebraMap A B)) :
    (KaehlerDifferential.kerTotal R A).map finsupp_map ⊔
        Submodule.span A (Set.range fun x : S => single (algebraMap S B x) (1 : B)) =
      (KaehlerDifferential.kerTotal S B).restrictScalars _ :=
  by
  rw [KaehlerDifferential.kerTotal, Submodule.map_span, KaehlerDifferential.kerTotal,
    Submodule.restrictScalars_span _ _ h]
  simp_rw [Set.image_union, Submodule.span_union, ← Set.image_univ, Set.image_image, Set.image_univ,
    map_sub, map_add]
  simp only [LinearMap.comp_apply, Finsupp.mapRange.linearMap_apply, Finsupp.mapRange_single,
    Finsupp.lmapDomain_apply, Finsupp.mapDomain_single, AlgHom.toLinearMap_apply,
    Algebra.ofId_apply, ← IsScalarTower.algebraMap_apply, map_one, map_add, map_mul]
  simp_rw [sup_assoc, ← (h.prod_map h).range_comp]
  congr 3
  rw [sup_eq_right]
  apply Submodule.span_mono
  simp_rw [IsScalarTower.algebraMap_apply R S B]
  exact Set.range_comp_subset_range (algebraMap R S) fun x => single (algebraMap S B x) (1 : B)
#align kaehler_differential.ker_total_map KaehlerDifferential.kerTotal_map

end Presentation

section ExactSequence

/- We have the commutative diagram
A --→ B
↑     ↑
|     |
R --→ S -/
variable (A B : Type _) [CommRing A] [CommRing B] [Algebra R A] [Algebra R B]

variable [Algebra A B] [Algebra S B] [IsScalarTower R A B] [IsScalarTower R S B]

variable {R B}

/-- For a tower `R → A → B` and an `R`-derivation `B → M`, we may compose with `A → B` to obtain an
`R`-derivation `A → M`. -/
def Derivation.compAlgebraMap [Module A M] [Module B M] [IsScalarTower A B M]
    (d : Derivation R B M) : Derivation R A M
    where
  map_one_eq_zero' := by simp
  leibniz' a b := by simp
  toLinearMap := d.toLinearMap.comp (IsScalarTower.toAlgHom R A B).toLinearMap
#align derivation.comp_algebra_map Derivation.compAlgebraMap

variable (R B)

/-- The map `Ω[A⁄R] →ₗ[A] Ω[B⁄R]` given a square
A --→ B
↑     ↑
|     |
R --→ S -/
def KaehlerDifferential.map : Ω[A⁄R] →ₗ[A] Ω[B⁄S] :=
  Derivation.liftKaehlerDifferential
    (((KaehlerDifferential.d S B).restrictScalars R).comp_algebraMap A)
#align kaehler_differential.map KaehlerDifferential.map

theorem KaehlerDifferential.map_compDer :
    (KaehlerDifferential.map R S A B).compDer (KaehlerDifferential.d R A) =
      ((KaehlerDifferential.d S B).restrictScalars R).comp_algebraMap A :=
  Derivation.liftKaehlerDifferential_comp _
#align kaehler_differential.map_comp_der KaehlerDifferential.map_compDer

theorem KaehlerDifferential.map_d (x : A) :
    KaehlerDifferential.map R S A B (KaehlerDifferential.d R A x) =
      KaehlerDifferential.d S B (algebraMap A B x) :=
  Derivation.congr_fun (KaehlerDifferential.map_compDer R S A B) x
#align kaehler_differential.map_D KaehlerDifferential.map_d

open IsScalarTower (toAlgHom)

theorem KaehlerDifferential.map_surjective_of_surjective
    (h : Function.Surjective (algebraMap A B)) :
    Function.Surjective (KaehlerDifferential.map R S A B) :=
  by
  rw [← LinearMap.range_eq_top, _root_.eq_top_iff, ← @Submodule.restrictScalars_top B A, ←
    KaehlerDifferential.span_range_derivation, Submodule.restrictScalars_span _ _ h,
    Submodule.span_le]
  rintro _ ⟨x, rfl⟩
  obtain ⟨y, rfl⟩ := h x
  rw [← KaehlerDifferential.map_d R S A B]
  exact ⟨_, rfl⟩
#align kaehler_differential.map_surjective_of_surjective KaehlerDifferential.map_surjective_of_surjective

/-- The lift of the map `Ω[A⁄R] →ₗ[A] Ω[B⁄R]` to the base change along `A → B`.
This is the first map in the exact sequence `B ⊗[A] Ω[A⁄R] → Ω[B⁄R] → Ω[B⁄A] → 0`. -/
noncomputable def KaehlerDifferential.mapBaseChange : B ⊗[A] Ω[A⁄R] →ₗ[B] Ω[B⁄R] :=
  (TensorProduct.isBaseChange A (Ω[A⁄R]) B).lift (KaehlerDifferential.map R R A B)
#align kaehler_differential.map_base_change KaehlerDifferential.mapBaseChange

@[simp]
theorem KaehlerDifferential.mapBaseChange_tmul (x : B) (y : Ω[A⁄R]) :
    KaehlerDifferential.mapBaseChange R A B (x ⊗ₜ y) = x • KaehlerDifferential.map R R A B y :=
  by
  conv_lhs => rw [← mul_one x, ← smul_eq_mul, ← TensorProduct.smul_tmul', LinearMap.map_smul]
  congr 1
  exact IsBaseChange.lift_eq _ _ _
#align kaehler_differential.map_base_change_tmul KaehlerDifferential.mapBaseChange_tmul

end ExactSequence

end KaehlerDifferential


import singular
import sigma_finite

/-
This file contains the definition of the countable sum of measures and
extends the Lebesgue decomposition and Radon-Nikodym theorem to σ-finite
measures.
-/

noncomputable theory
open_locale classical big_operators nnreal ennreal

variables {α β : Type*} [measurable_space α]

open measure_theory

lemma tsum_measure_empty {μ : ℕ → measure α} : ∑' n, μ n ∅ = 0 :=
begin
  convert tsum_zero,
  { exact funext (λ n, measure_empty) },
  { apply_instance },
end

lemma tsum_measure_m_Union {μ : ℕ → measure α} ⦃f : ℕ → set α⦄
  (hf₁ : ∀ (i : ℕ), measurable_set (f i)) (hf₂ : pairwise (disjoint on f)) :
  ∑' (n : ℕ), (μ n) (⋃ (i : ℕ), f i) = ∑' (i n : ℕ), (μ n) (f i) :=
begin
  rw tsum_comm',
  { exact tsum_congr (λ n, measure_Union hf₂ hf₁) },
  exacts [ennreal.summable, λ _, ennreal.summable, λ _, ennreal.summable]
end

def tsum_measure (μ : ℕ → measure α) : measure α :=
measure.of_measurable (λ s hs, ∑' n, μ n s) tsum_measure_empty tsum_measure_m_Union

lemma tsum_measure_apply {μ : ℕ → measure α} (i : set α) (hi : measurable_set i) :
  tsum_measure μ i = ∑' n, μ n i :=
measure.of_measurable_apply i hi

lemma tsum_measure_zero : tsum_measure (0 : ℕ → measure α) = 0 :=
begin
  refine measure_theory.measure.ext (λ i hi, _),
  rw [tsum_measure_apply i hi],
  exact tsum_zero
end

lemma tsum_measure_add {μ ν : ℕ → measure α} :
  tsum_measure μ + tsum_measure ν = tsum_measure (μ + ν) :=
begin
  refine measure_theory.measure.ext (λ i hi, _),
  rw [measure.coe_add, pi.add_apply, tsum_measure_apply i hi,
      tsum_measure_apply i hi, tsum_measure_apply i hi],
  exact (tsum_add (ennreal.summable) (ennreal.summable)).symm,
end

lemma tsum_measure_singular {μ : ℕ → measure α} {ν : measure α}
  (h : ∀ n, μ n ⊥ ν) : tsum_measure μ ⊥ ν :=
begin
  choose s hs₁ hs₂ hs₃ using h,
  refine ⟨⋂ n, s n, measurable_set.Inter hs₁, _, _⟩,
  { rw tsum_measure_apply _ (measurable_set.Inter hs₁),
    convert tsum_zero,
    exact funext (λ n, nonpos_iff_eq_zero.1
      (hs₂ n ▸ (measure_mono (set.Inter_subset s n)))),
    apply_instance },
  { rw set.compl_Inter,
    refine nonpos_iff_eq_zero.1 ( le_trans (measure_Union_le _) (le_of_eq _)),
    convert tsum_zero,
    exact funext (λ n, hs₃ n),
    apply_instance }
end

namespace signed_measure

local infix ` . `:max := measure.with_density

lemma with_density_tsum {μ : measure α} {f : ℕ → α → ℝ≥0∞}
  (hf : ∀ n, measurable (f n)) : μ . ∑' n, f n = tsum_measure (λ n, μ . (f n)) :=
begin
  refine measure_theory.measure.ext (λ s hs, _),
  rw [tsum_measure_apply s hs, with_density_apply _ hs],
  sorry,
  -- exact lintegral_tsum,
end

/-- The Lebesgue decomposition theorem extended to σ-finite measures. -/
theorem exists_singular_with_density'
  (μ ν : measure α) [finite_measure μ] [sigma_finite ν] :
  ∃ (ν₁ ν₂ : measure α) (hν : ν = ν₁ + ν₂), ν₁ ⊥ μ ∧
  ∃ (f : α → ℝ≥0∞) (hf : measurable f), ν₂ = μ . f :=
begin
  obtain ⟨S, hS⟩ := exists_disjoint_finite_spanning_sets_in ν,

  have : ∀ n : ℕ, ∃ (ν₁ ν₂ : measure α) (hν : ν.restrict (S.set n) = ν₁ + ν₂),
    ν₁ ⊥ μ ∧ ∃ (f : α → ℝ≥0∞) (hf : measurable f), ν₂ = μ . f,
  { intro n,
    haveI : finite_measure (ν.restrict (S.set n)) :=
      @restrict.finite_measure _ _ _ ν (fact_iff.2 (S.finite n)),
    exact exists_singular_with_density _ _ },

  choose ν₁ ν₂ hνa hνb f hνc hνd using this,

  refine ⟨tsum_measure ν₁, tsum_measure ν₂, _, tsum_measure_singular hνb, _⟩,
  { rw tsum_measure_add,
    refine measure_theory.measure.ext (λ i hi, _),
    rw [tsum_measure_apply i hi],
    simp only [measure.coe_add, pi.add_apply],
    rw [show ∑' n, (ν₁ n i + ν₂ n i) = ∑' n, (ν.restrict (S.set n)) i,
        by exact tsum_congr (λ n, (hνa n).symm ▸ rfl),
        ← measure.restrict_Union_apply hS S.set_mem hi, S.spanning,
        measure.restrict_univ] },
  { refine ⟨∑' n, f n, _, _⟩,
    { convert measurable.ennreal_tsum hνc,
      exact funext (λ x, tsum_apply (pi.summable.2 (λ n, ennreal.summable))) },
    { refine measure_theory.measure.ext (λ i hi, _),
      simp_rw [tsum_measure_apply i hi, hνd],
      sorry

    } }
end

end signed_measure


/-
Copyright (c) 2022 Yaël Dillies, George Shakan. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies, George Shakan

! This file was ported from Lean 3 source module combinatorics.additive.pluennecke_ruzsa
! leanprover-community/mathlib commit 4aab2abced69a9e579b1e6dc2856ed3db48e2cbd
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Combinatorics.DoubleCounting
import Mathlib.Data.Finset.Pointwise
import Mathlib.Data.Rat.NNRat

/-!
# The Plünnecke-Ruzsa inequality

This file proves Ruzsa's triangle inequality, the Plünnecke-Petridis lemma, and the Plünnecke-Ruzsa
inequality.

## Main declarations

* `Finset.card_sub_mul_le_card_sub_mul_card_sub`: Ruzsa's triangle inequality, difference version.
* `Finset.card_add_mul_le_card_add_mul_card_add`: Ruzsa's triangle inequality, sum version.
* `Finset.pluennecke_petridis`: The Plünnecke-Petridis lemma.
* `Finset.card_smul_div_smul_le`: The Plünnecke-Ruzsa inequality.

## References

* [Giorgis Petridis, *The Plünnecke-Ruzsa inequality: an overview*][petridis2014]
* [Terrence Tao, Van Vu, *Additive Combinatorics][tao-vu]
-/

open Nat

open NNRat Pointwise

namespace Finset

variable {α : Type _} [CommGroup α] [DecidableEq α] {A B C : Finset α}

/-- **Ruzsa's triangle inequality**. Division version. -/
@[to_additive card_sub_mul_le_card_sub_mul_card_sub
      "**Ruzsa's triangle inequality**. Subtraction version."]
theorem card_div_mul_le_card_div_mul_card_div (A B C : Finset α) :
    (A / C).card * B.card ≤ (A / B).card * (B / C).card := by
  rw [← card_product (A / B), ← mul_one (Finset.product _ _).card]
  refine' card_mul_le_card_mul (fun b ac ↦ ac.1 * ac.2 = b) (fun x hx ↦ _)
    fun x _ ↦ card_le_one_iff.2 fun hu hv ↦
      ((mem_bipartiteBelow _).1 hu).2.symm.trans ((mem_bipartiteBelow _).1 hv).2
  obtain ⟨a, c, ha, hc, rfl⟩ := mem_div.1 hx
  refine' card_le_card_of_inj_on (fun b ↦ (a / b, b / c)) (fun b hb ↦ _) fun b₁ _ b₂ _ h ↦ _
  · rw [mem_bipartiteAbove]
    exact ⟨mk_mem_product (div_mem_div ha hb) (div_mem_div hb hc), div_mul_div_cancel' _ _ _⟩
  · exact div_right_injective (Prod.ext_iff.1 h).1
#align finset.card_div_mul_le_card_div_mul_card_div Finset.card_div_mul_le_card_div_mul_card_div
#align finset.card_sub_mul_le_card_sub_mul_card_sub Finset.card_sub_mul_le_card_sub_mul_card_sub

/-- **Ruzsa's triangle inequality**. Div-mul-mul version. -/
@[to_additive card_sub_mul_le_card_add_mul_card_add
      "**Ruzsa's triangle inequality**. Sub-add-add version."]
theorem card_div_mul_le_card_mul_mul_card_mul (A B C : Finset α) :
    (A / C).card * B.card ≤ (A * B).card * (B * C).card := by
  rw [← div_inv_eq_mul, ← card_inv B, ← card_inv (B * C), mul_inv, ← div_eq_mul_inv]
  exact card_div_mul_le_card_div_mul_card_div _ _ _
#align finset.card_div_mul_le_card_mul_mul_card_mul Finset.card_div_mul_le_card_mul_mul_card_mul
#align finset.card_sub_mul_le_card_add_mul_card_add Finset.card_sub_mul_le_card_add_mul_card_add

/-- **Ruzsa's triangle inequality**. Mul-div-div version. -/
@[to_additive card_add_mul_le_card_sub_mul_card_add
      "**Ruzsa's triangle inequality**. Add-sub-sub version."]
theorem card_mul_mul_le_card_div_mul_card_mul (A B C : Finset α) :
    (A * C).card * B.card ≤ (A / B).card * (B * C).card := by
  rw [← div_inv_eq_mul, ← div_inv_eq_mul B]
  exact card_div_mul_le_card_div_mul_card_div _ _ _
#align finset.card_mul_mul_le_card_div_mul_card_mul Finset.card_mul_mul_le_card_div_mul_card_mul
#align finset.card_add_mul_le_card_sub_mul_card_add Finset.card_add_mul_le_card_sub_mul_card_add

/-- **Ruzsa's triangle inequality**. Mul-mul-div version. -/
@[to_additive card_add_mul_le_card_add_mul_card_sub
      "**Ruzsa's triangle inequality**. Add-add-sub version."]
theorem card_mul_mul_le_card_mul_mul_card_div (A B C : Finset α) :
    (A * C).card * B.card ≤ (A * B).card * (B / C).card := by
  rw [← div_inv_eq_mul, div_eq_mul_inv B]
  exact card_div_mul_le_card_mul_mul_card_mul _ _ _
#align finset.card_mul_mul_le_card_mul_mul_card_div Finset.card_mul_mul_le_card_mul_mul_card_div
#align finset.card_add_mul_le_card_add_mul_card_sub Finset.card_add_mul_le_card_add_mul_card_sub

@[to_additive]
theorem mul_pluennecke_petridis (C : Finset α)
    (hA : ∀ (A') (_ : A' ⊆ A), (A * B).card * A'.card ≤ (A' * B).card * A.card) :
    (A * B * C).card * A.card ≤ (A * B).card * (A * C).card := by
  induction' C using Finset.induction_on with x C _ ih
  · simp
  set A' := A ∩ (A * C / {x}) with hA'
  set C' := insert x C with hC'
  have h₀ : A' * {x} = A * {x} ∩ (A * C) := by
    rw [hA', inter_mul_singleton, (isUnit_singleton x).div_mul_cancel]
  have h₁ : A * B * C' = A * B * C ∪ (A * B * {x}) \ (A' * B * {x}) := by
    rw [hC', insert_eq, union_comm, mul_union]
    refine' (sup_sdiff_eq_sup _).symm
    rw [mul_right_comm, mul_right_comm A, h₀]
    exact mul_subset_mul_right (inter_subset_right _ _)
  have h₂ : A' * B * {x} ⊆ A * B * {x} :=
    mul_subset_mul_right (mul_subset_mul_right <| inter_subset_left _ _)
  have h₃ : (A * B * C').card ≤ (A * B * C).card + (A * B).card - (A' * B).card := by
    rw [h₁]
    refine' (card_union_le _ _).trans_eq _
    rw [card_sdiff h₂, ← add_tsub_assoc_of_le (card_le_of_subset h₂), card_mul_singleton,
      card_mul_singleton]
  refine' (mul_le_mul_right' h₃ _).trans _
  rw [tsub_mul, add_mul]
  refine' (tsub_le_tsub (add_le_add_right ih _) <| hA _ <| inter_subset_left _ _).trans_eq _
  rw [← mul_add, ← mul_tsub, ← hA', hC', insert_eq, mul_union, ← card_mul_singleton A x, ←
    card_mul_singleton A' x, add_comm (card _), h₀,
    eq_tsub_of_add_eq (card_union_add_card_inter _ _)]
#align finset.mul_pluennecke_petridis Finset.mul_pluennecke_petridis
#align finset.add_pluennecke_petridis Finset.add_pluennecke_petridis

/-! ### Sum triangle inequality -/

-- Auxiliary lemma for Ruzsa's triangle sum inequality, and the Plünnecke-Ruzsa inequality.
@[to_additive]
private theorem mul_aux (hA : A.Nonempty) (hAB : A ⊆ B)
    (h : ∀ A' ∈ B.powerset.erase ∅, ((A * C).card : ℚ≥0) / ↑A.card ≤ (A' * C).card / ↑A'.card) :
    ∀ (A') (_ : A' ⊆ A), (A * C).card * A'.card ≤ (A' * C).card * A.card := by
  rintro A' hAA'
  obtain rfl | hA' := A'.eq_empty_or_nonempty
  · simp
  have hA₀ : (0 : ℚ≥0) < A.card := cast_pos.2 hA.card_pos
  have hA₀' : (0 : ℚ≥0) < A'.card := cast_pos.2 hA'.card_pos
  exact_mod_cast
    (div_le_div_iff hA₀ hA₀').1
      (h _ <| mem_erase_of_ne_of_mem hA'.ne_empty <| mem_powerset.2 <| hAA'.trans hAB)

/-- **Ruzsa's triangle inequality**. Multiplication version. -/
@[to_additive card_add_mul_card_le_card_add_mul_card_add
      "**Ruzsa's triangle inequality**. Addition version."]
theorem card_mul_mul_card_le_card_mul_mul_card_mul (A B C : Finset α) :
    (A * C).card * B.card ≤ (A * B).card * (B * C).card := by
  obtain rfl | hB := B.eq_empty_or_nonempty
  · simp
  have hB' : B ∈ B.powerset.erase ∅ := mem_erase_of_ne_of_mem hB.ne_empty (mem_powerset_self _)
  obtain ⟨U, hU, hUA⟩ :=
    exists_min_image (B.powerset.erase ∅) (fun U ↦ (U * A).card / U.card : _ → ℚ≥0) ⟨B, hB'⟩
  rw [mem_erase, mem_powerset, ← nonempty_iff_ne_empty] at hU
  refine' cast_le.1 (_ : (_ : ℚ≥0) ≤ _)
  push_cast
  refine' (le_div_iff <| cast_pos.2 hB.card_pos).1 _
  rw [mul_div_right_comm, mul_comm _ B]
  refine' (cast_le.2 <| card_le_card_mul_left _ hU.1).trans _
  refine' le_trans _
    (mul_le_mul (hUA _ hB') (cast_le.2 <| card_le_of_subset <| mul_subset_mul_right hU.2)
      (zero_le _) (zero_le _))
  rw [← mul_div_right_comm, ← mul_assoc]
  refine' (le_div_iff <| cast_pos.2 hU.1.card_pos).2 _
  exact_mod_cast mul_pluennecke_petridis C (mul_aux hU.1 hU.2 hUA)
#align finset.card_mul_mul_card_le_card_mul_mul_card_mul Finset.card_mul_mul_card_le_card_mul_mul_card_mul
#align finset.card_add_mul_card_le_card_add_mul_card_add Finset.card_add_mul_card_le_card_add_mul_card_add

/-- **Ruzsa's triangle inequality**. Add-sub-sub version. -/
theorem card_mul_mul_le_card_div_mul_card_div (A B C : Finset α) :
    (A * C).card * B.card ≤ (A / B).card * (B / C).card := by
  rw [div_eq_mul_inv, ← card_inv B, ← card_inv (B / C), inv_div', div_inv_eq_mul]
  exact card_mul_mul_card_le_card_mul_mul_card_mul _ _ _
#align finset.card_mul_mul_le_card_div_mul_card_div Finset.card_mul_mul_le_card_div_mul_card_div

/-- **Ruzsa's triangle inequality**. Sub-add-sub version. -/
theorem card_div_mul_le_card_mul_mul_card_div (A B C : Finset α) :
    (A / C).card * B.card ≤ (A * B).card * (B / C).card := by
  rw [div_eq_mul_inv, div_eq_mul_inv]
  exact card_mul_mul_card_le_card_mul_mul_card_mul _ _ _
#align finset.card_div_mul_le_card_mul_mul_card_div Finset.card_div_mul_le_card_mul_mul_card_div

/-- **Ruzsa's triangle inequality**. Sub-sub-add version. -/
theorem card_div_mul_le_card_div_mul_card_mul (A B C : Finset α) :
    (A / C).card * B.card ≤ (A / B).card * (B * C).card := by
  rw [← div_inv_eq_mul, div_eq_mul_inv]
  exact card_mul_mul_le_card_div_mul_card_div _ _ _
#align finset.card_div_mul_le_card_div_mul_card_mul Finset.card_div_mul_le_card_div_mul_card_mul

theorem card_add_nsmul_le {α : Type _} [AddCommGroup α] [DecidableEq α] {A B : Finset α}
    (hAB : ∀ (A') (_ : A' ⊆ A), (A + B).card * A'.card ≤ (A' + B).card * A.card) (n : ℕ) :
    (A + n • B).card ≤ ((A + B).card / A.card : ℚ≥0) ^ n * A.card := by
  obtain rfl | hA := A.eq_empty_or_nonempty
  · simp
  induction' n with n ih
  · simp
  rw [succ_nsmul, ← add_assoc, _root_.pow_succ, mul_assoc, ← mul_div_right_comm, le_div_iff,
    ← cast_mul]
  swap; exact cast_pos.2 hA.card_pos
  refine' (cast_le.2 <| add_pluennecke_petridis _ hAB).trans _
  rw [cast_mul]
  exact mul_le_mul_of_nonneg_left ih (zero_le _)
#align finset.card_add_nsmul_le Finset.card_add_nsmul_le

@[to_additive existing]
theorem card_mul_pow_le (hAB : ∀ (A') (_ : A' ⊆ A), (A * B).card * A'.card ≤ (A' * B).card * A.card)
    (n : ℕ) : (A * B ^ n).card ≤ ((A * B).card / A.card : ℚ≥0) ^ n * A.card := by
  obtain rfl | hA := A.eq_empty_or_nonempty
  · simp
  induction' n with n ih
  · simp
  rw [_root_.pow_succ, ← mul_assoc, _root_.pow_succ, @mul_assoc ℚ≥0, ← mul_div_right_comm,
    le_div_iff, ← cast_mul]
  swap; exact cast_pos.2 hA.card_pos
  refine' (cast_le.2 <| mul_pluennecke_petridis _ hAB).trans _
  rw [cast_mul]
  exact mul_le_mul_of_nonneg_left ih (zero_le _)
#align finset.card_mul_pow_le Finset.card_mul_pow_le

/-- The **Plünnecke-Ruzsa inequality**. Multiplication version. Note that this is genuinely harder
than the division version because we cannot use a double counting argument. -/
@[to_additive "The **Plünnecke-Ruzsa inequality**. Addition version. Note that this is genuinely
harder than the subtraction version because we cannot use a double counting argument."]

/-- The **Plünnecke-Ruzsa inequality**. Subtraction version. -/
@[to_additive "The **Plünnecke-Ruzsa inequality**. Subtraction version."]
theorem card_pow_div_pow_le' (hA : A.Nonempty) (B : Finset α) (m n : ℕ) :
    (B ^ m / B ^ n).card ≤ ((A / B).card / A.card : ℚ≥0) ^ (m + n) * A.card := by
  rw [← card_inv, inv_div', ← inv_pow, ← inv_pow, div_eq_mul_inv A]
  exact card_pow_div_pow_le hA _ _ _
#align finset.card_pow_div_pow_le' Finset.card_pow_div_pow_le'
#align finset.card_nsmul_sub_nsmul_le' Finset.card_nsmul_sub_nsmul_le'

/-- Special case of the **Plünnecke-Ruzsa inequality**. Multiplication version. -/
@[to_additive "Special case of the **Plünnecke-Ruzsa inequality**. Addition version."]
theorem card_pow_le (hA : A.Nonempty) (B : Finset α) (n : ℕ) :
    (B ^ n).card ≤ ((A * B).card / A.card : ℚ≥0) ^ n * A.card := by
  simpa only [_root_.pow_zero, div_one] using card_pow_div_pow_le hA _ _ 0
#align finset.card_pow_le Finset.card_pow_le
#align finset.card_nsmul_le Finset.card_nsmul_le

/-- Special case of the **Plünnecke-Ruzsa inequality**. Division version. -/
@[to_additive "Special case of the **Plünnecke-Ruzsa inequality**. Subtraction version."]
theorem card_pow_le' (hA : A.Nonempty) (B : Finset α) (n : ℕ) :
    (B ^ n).card ≤ ((A / B).card / A.card : ℚ≥0) ^ n * A.card := by
  simpa only [_root_.pow_zero, div_one] using card_pow_div_pow_le' hA _ _ 0
#align finset.card_pow_le' Finset.card_pow_le'
#align finset.card_nsmul_le' Finset.card_nsmul_le'

end Finset


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

import data.equiv.basic
import data.set.finite
import group_theory.perm.sign

/-! # Equivalence between fintypes

This file contains some basic results on equivalences where one or both
sides of the equivalence are `fintype`s.

# Main definitions

 - `function.embedding.to_equiv_range`: computably turn an embedding of a
   fintype into an `equiv` of the domain to its range
 - `equiv.perm.via_fintype_embedding : perm α → (α ↪ β) → perm β` extends the domain of
   a permutation, fixing everything outside the range of the embedding

# Implementation details

 - `function.embedding.to_equiv_range` uses a computable inverse, but one that has poor
   computational performance, since it operates by exhaustive search over the input `fintype`s.
-/

variables {α β : Type*} [fintype α] [decidable_eq β] (e : equiv.perm α) (f : α ↪ β)

/--
Computably turn an embedding `f : α ↪ β` into an equiv `α ≃ set.range f`,
if `α` is a `fintype`. Has poor computational performance, due to exhaustive searching in
constructed inverse. When a better inverse is known, use `equiv.of_left_inverse'` or
`equiv.of_left_inverse` instead. This is the computable version of `equiv.of_injective`.
-/
def function.embedding.to_equiv_range : α ≃ set.range f :=
⟨λ a, ⟨f a, set.mem_range_self a⟩, f.inv_of_mem_range, λ _, by simp, λ _, by simp⟩

@[simp] lemma function.embedding.to_equiv_range_apply (a : α) :
  f.to_equiv_range a = ⟨f a, set.mem_range_self a⟩ := rfl

@[simp] lemma function.embedding.to_equiv_range_symm_apply_self (a : α) :
  f.to_equiv_range.symm ⟨f a, set.mem_range_self a⟩ = a :=
by simp [equiv.symm_apply_eq]

lemma function.embedding.to_equiv_range_eq_of_injective :
  f.to_equiv_range = equiv.of_injective f f.injective :=
by { ext, simp }

/--
Extend the domain of `e : equiv.perm α`, mapping it through `f : α ↪ β`.
Everything outside of `set.range f` is kept fixed. Has poor computational performance,
due to exhaustive searching in constructed inverse due to using `function.embedding.to_equiv_range`.
When a better `α ≃ set.range f` is known, use `equiv.perm.via_set_range`.
When `[fintype α]` is not available, a noncomputable version is available as
`equiv.perm.via_embedding`.
-/
def equiv.perm.via_fintype_embedding : equiv.perm β :=
e.extend_domain f.to_equiv_range

@[simp] lemma equiv.perm.via_fintype_embedding_apply_image (a : α) :
  e.via_fintype_embedding f (f a) = f (e a) :=
begin
  rw equiv.perm.via_fintype_embedding,
  convert equiv.perm.extend_domain_apply_image e _ _
end

lemma equiv.perm.via_fintype_embedding_apply_mem_range {b : β} (h : b ∈ set.range f) :
  e.via_fintype_embedding f b = f (e (f.inv_of_mem_range ⟨b, h⟩)) :=
by simpa [equiv.perm.via_fintype_embedding, equiv.perm.extend_domain_apply_subtype, h]

lemma equiv.perm.via_fintype_embedding_apply_not_mem_range {b : β} (h : b ∉ set.range f) :
  e.via_fintype_embedding f b = b :=
by rwa [equiv.perm.via_fintype_embedding, equiv.perm.extend_domain_apply_not_subtype]

@[simp] lemma equiv.perm.via_fintype_embedding_sign [decidable_eq α] [fintype β] :
  equiv.perm.sign (e.via_fintype_embedding f) = equiv.perm.sign e :=
by simp [equiv.perm.via_fintype_embedding]

namespace equiv
variables {p q : α → Prop} [decidable_pred p] [decidable_pred q]

/-- If `e` is an equivalence between two subtypes of a fintype `α`, `e.to_compl`
is an equivalence between the complement of those subtypes.

See also `equiv.compl`, for a computable version when a term of type
`{e' : α ≃ α // ∀ x : {x // p x}, e' x = e x}` is known. -/
noncomputable def to_compl (e : {x // p x} ≃ {x // q x}) : {x // ¬ p x} ≃ {x // ¬ q x} :=
classical.choice (fintype.card_eq.mp (fintype.card_compl_eq_card_compl (fintype.card_congr e)))

/-- If `e` is an equivalence between two subtypes of a fintype `α`, `e.extend_subtype`
is a permutation of `α` acting like `e` on the subtypes and doing something arbitrary outside.

Note that when `p = q`, `equiv.perm.subtype_congr e (equiv.refl _)` can be used instead. -/
noncomputable abbreviation extend_subtype (e : {x // p x} ≃ {x // q x}) : perm α :=
subtype_congr e e.to_compl

lemma extend_subtype_apply_of_mem (e : {x // p x} ≃ {x // q x}) (x) (hx : p x) :
  e.extend_subtype x = e ⟨x, hx⟩ :=
by { dunfold extend_subtype,
     simp only [subtype_congr, equiv.trans_apply, equiv.sum_congr_apply],
     rw [sum_compl_apply_symm_of_pos _ _ hx, sum.map_inl, sum_compl_apply_inl] }

lemma extend_subtype_mem (e : {x // p x} ≃ {x // q x}) (x) (hx : p x) :
  q (e.extend_subtype x) :=
by { convert (e ⟨x, hx⟩).2,
     rw [e.extend_subtype_apply_of_mem _ hx, subtype.val_eq_coe] }

lemma extend_subtype_apply_of_not_mem (e : {x // p x} ≃ {x // q x}) (x) (hx : ¬ p x) :
  e.extend_subtype x = e.to_compl ⟨x, hx⟩ :=
by { dunfold extend_subtype,
     simp only [subtype_congr, equiv.trans_apply, equiv.sum_congr_apply],
     rw [sum_compl_apply_symm_of_neg _ _ hx, sum.map_inr, sum_compl_apply_inr] }

lemma extend_subtype_not_mem (e : {x // p x} ≃ {x // q x}) (x) (hx : ¬ p x) :
  ¬ q (e.extend_subtype x) :=
by { convert (e.to_compl ⟨x, hx⟩).2,
     rw [e.extend_subtype_apply_of_not_mem _ hx, subtype.val_eq_coe] }

end equiv


/-
Copyright (c) 2020 Aaron Anderson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Aaron Anderson
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.finsupp.basic
import Mathlib.algebra.ordered_group
import Mathlib.PostPort

universes u_1 u_3 u_2 u_4

namespace Mathlib

/-!
# Lattice structure on finsupps

This file provides instances of ordered structures on finsupps.

-/

namespace finsupp

protected instance order_bot {α : Type u_1} {μ : Type u_3} [canonically_ordered_add_monoid μ] :
    order_bot (α →₀ μ) :=
  order_bot.mk 0 partial_order.le partial_order.lt sorry sorry sorry sorry

protected instance semilattice_inf {α : Type u_1} {β : Type u_2} [HasZero β] [semilattice_inf β] :
    semilattice_inf (α →₀ β) :=
  semilattice_inf.mk (zip_with has_inf.inf sorry) partial_order.le partial_order.lt sorry sorry
    sorry sorry sorry sorry

@[simp] theorem inf_apply {α : Type u_1} {β : Type u_2} [HasZero β] [semilattice_inf β] {a : α}
    {f : α →₀ β} {g : α →₀ β} : coe_fn (f ⊓ g) a = coe_fn f a ⊓ coe_fn g a :=
  rfl

@[simp] theorem support_inf {α : Type u_1} {γ : Type u_4} [canonically_linear_ordered_add_monoid γ]
    {f : α →₀ γ} {g : α →₀ γ} : support (f ⊓ g) = support f ∩ support g :=
  sorry

protected instance semilattice_sup {α : Type u_1} {β : Type u_2} [HasZero β] [semilattice_sup β] :
    semilattice_sup (α →₀ β) :=
  semilattice_sup.mk (zip_with has_sup.sup sorry) partial_order.le partial_order.lt sorry sorry
    sorry sorry sorry sorry

@[simp] theorem sup_apply {α : Type u_1} {β : Type u_2} [HasZero β] [semilattice_sup β] {a : α}
    {f : α →₀ β} {g : α →₀ β} : coe_fn (f ⊔ g) a = coe_fn f a ⊔ coe_fn g a :=
  rfl

@[simp] theorem support_sup {α : Type u_1} {γ : Type u_4} [canonically_linear_ordered_add_monoid γ]
    {f : α →₀ γ} {g : α →₀ γ} : support (f ⊔ g) = support f ∪ support g :=
  sorry

protected instance lattice {α : Type u_1} {β : Type u_2} [HasZero β] [lattice β] :
    lattice (α →₀ β) :=
  lattice.mk semilattice_sup.sup semilattice_inf.le semilattice_inf.lt sorry sorry sorry sorry sorry
    sorry semilattice_inf.inf sorry sorry sorry

protected instance semilattice_inf_bot {α : Type u_1} {γ : Type u_4}
    [canonically_linear_ordered_add_monoid γ] : semilattice_inf_bot (α →₀ γ) :=
  semilattice_inf_bot.mk order_bot.bot order_bot.le order_bot.lt sorry sorry sorry sorry lattice.inf
    sorry sorry sorry

theorem bot_eq_zero {α : Type u_1} {γ : Type u_4} [canonically_linear_ordered_add_monoid γ] :
    ⊥ = 0 :=
  rfl

theorem disjoint_iff {α : Type u_1} {γ : Type u_4} [canonically_linear_ordered_add_monoid γ]
    {x : α →₀ γ} {y : α →₀ γ} : disjoint x y ↔ disjoint (support x) (support y) :=
  sorry

/-- The order on `finsupp`s over a partial order embeds into the order on functions -/
def order_embedding_to_fun {α : Type u_1} {β : Type u_2} [HasZero β] [partial_order β] :
    (α →₀ β) ↪o (α → β) :=
  rel_embedding.mk (function.embedding.mk (fun (f : α →₀ β) (a : α) => coe_fn f a) sorry) sorry

@[simp] theorem order_embedding_to_fun_apply {α : Type u_1} {β : Type u_2} [HasZero β]
    [partial_order β] {f : α →₀ β} {a : α} : coe_fn order_embedding_to_fun f a = coe_fn f a :=
  rfl

theorem monotone_to_fun {α : Type u_1} {β : Type u_2} [HasZero β] [partial_order β] :
    monotone to_fun :=
  fun (f g : α →₀ β) (h : f ≤ g) (a : α) => iff.mp le_def h a

end Mathlib