/-
Copyright (c) 2022 Jujian Zhang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jujian Zhang

From: https://github.com/leanprover-community/mathlib/blob/ae10dceda978370b312f93a53a0e93fd2157d5bf/src/algebraic_geometry/projective_spectrum/structure_sheaf.lean
-/
import topology.sheaves.local_predicate
import algebraic_geometry.locally_ringed_space

import .homogeneous_localization
import .topology

/-!
# The structure sheaf on `projective_spectrum 𝒜`.

In `src/algebraic_geometry/topology.lean`, we have given a topology on `projective_spectrum 𝒜`; in
this file we will construct a sheaf on `projective_spectrum 𝒜`.

## Notation
- `R` is a commutative semiring;
- `A` is a commutative ring and an `R`-algebra;
- `𝒜 : ℕ → submodule R A` is the grading of `A`;
- `U` is opposite object of some open subset of `projective_spectrum.Top`.

## Main definitions and results
We define the structure sheaf as the subsheaf of all dependent function
`f : Π x : U, homogeneous_localization 𝒜 x` such that `f` is locally expressible as ratio of two
elements of the *same grading*, i.e. `∀ y ∈ U, ∃ (V ⊆ U) (i : ℕ) (a b ∈ 𝒜 i), ∀ z ∈ V, f z = a / b`.

* `algebraic_geometry.projective_spectrum.structure_sheaf.is_locally_fraction`: the predicate that
  a dependent function is locally expressible as a ratio of two elements of the same grading.
* `algebraic_geometry.projective_spectrum.structure_sheaf.sections_subring`: the dependent functions
  satisfying the above local property forms a subring of all dependent functions
  `Π x : U, homogeneous_localization 𝒜 x`.
* `algebraic_geometry.Proj.structure_sheaf`: the sheaf with `U ↦ sections_subring U` and natural
  restriction map.

Then we establish that `Proj 𝒜` is a `LocallyRingedSpace`:
* `algebraic_geometry.Proj.stalk_iso'`: for any `x : projective_spectrum 𝒜`, the stalk of
  `Proj.structure_sheaf` at `x` is isomorphic to `homogeneous_localization 𝒜 x`.
* `algebraic_geometry.Proj.to_LocallyRingedSpace`: `Proj` as a locally ringed space.

## References

* [Robin Hartshorne, *Algebraic Geometry*][Har77]

-/

noncomputable theory

namespace algebraic_geometry

open_locale direct_sum big_operators pointwise
open direct_sum set_like localization Top topological_space category_theory opposite

variables {R A: Type*}
variables [comm_ring R] [comm_ring A] [algebra R A]
variables (𝒜 : ℕ → submodule R A) [graded_algebra 𝒜]

local notation `at ` x := homogeneous_localization 𝒜 x.as_homogeneous_ideal.to_ideal

namespace projective_spectrum.structure_sheaf

variables {𝒜}

/--
The predicate saying that a dependent function on an open `U` is realised as a fixed fraction
`r / s` of *same grading* in each of the stalks (which are localizations at various prime ideals).
-/
def is_fraction {U : opens (projective_spectrum.Top 𝒜)} (f : Π x : U, at x.1) : Prop :=
∃ (i : ℕ) (r s : 𝒜 i),
  ∀ x : U, ∃ (s_nin : s.1 ∉ x.1.as_homogeneous_ideal),
  (f x) = quotient.mk' ⟨i, r, s, s_nin⟩

variables (𝒜)

/--
The predicate `is_fraction` is "prelocal", in the sense that if it holds on `U` it holds on any open
subset `V` of `U`.
-/
def is_fraction_prelocal : prelocal_predicate (λ (x : projective_spectrum.Top 𝒜), at x) :=
{ pred := λ U f, is_fraction f,
  res := by rintros V U i f ⟨j, r, s, w⟩; exact ⟨j, r, s, λ y, w (i y)⟩ }

/--
We will define the structure sheaf as the subsheaf of all dependent functions in
`Π x : U, homogeneous_localization 𝒜 x` consisting of those functions which can locally be expressed
as a ratio of `A` of same grading.-/
def is_locally_fraction : local_predicate (λ (x : projective_spectrum.Top 𝒜), at x) :=
(is_fraction_prelocal 𝒜).sheafify

namespace section_subring
variable {𝒜}

open submodule set_like.graded_monoid homogeneous_localization

lemma zero_mem' (U : (opens (projective_spectrum.Top 𝒜))ᵒᵖ) :
  (is_locally_fraction 𝒜).pred (0 : Π x : unop U, at x.1) :=
λ x, ⟨unop U, x.2, 𝟙 (unop U), ⟨0, ⟨0, zero_mem _⟩, ⟨1, one_mem⟩, λ y, ⟨_, rfl⟩⟩⟩

lemma one_mem' (U : (opens (projective_spectrum.Top 𝒜))ᵒᵖ) :
  (is_locally_fraction 𝒜).pred (1 : Π x : unop U, at x.1) :=
λ x, ⟨unop U, x.2, 𝟙 (unop U), ⟨0, ⟨1, one_mem⟩, ⟨1, one_mem⟩, λ y, ⟨_, rfl⟩⟩⟩

lemma add_mem' (U : (opens (projective_spectrum.Top 𝒜))ᵒᵖ)
  (a b : Π x : unop U, at x.1)
  (ha : (is_locally_fraction 𝒜).pred a) (hb : (is_locally_fraction 𝒜).pred b) :
  (is_locally_fraction 𝒜).pred (a + b) := λ x,
begin
  rcases ha x with ⟨Va, ma, ia, ja, ⟨ra, ra_mem⟩, ⟨sa, sa_mem⟩, wa⟩,
  rcases hb x with ⟨Vb, mb, ib, jb, ⟨rb, rb_mem⟩, ⟨sb, sb_mem⟩, wb⟩,
  refine ⟨Va ⊓ Vb, ⟨ma, mb⟩, opens.inf_le_left _ _ ≫ ia, ja + jb,
    ⟨sb * ra + sa * rb, add_mem (add_comm jb ja ▸ mul_mem sb_mem ra_mem : sb * ra ∈ 𝒜 (ja + jb))
      (mul_mem sa_mem rb_mem)⟩,
    ⟨sa * sb, mul_mem sa_mem sb_mem⟩, λ y, ⟨λ h, _, _⟩⟩,
  { cases (y : projective_spectrum.Top 𝒜).is_prime.mem_or_mem h with h h,
    { obtain ⟨nin, -⟩ := (wa ⟨y, (opens.inf_le_left Va Vb y).2⟩), exact nin h },
    { obtain ⟨nin, -⟩ := (wb ⟨y, (opens.inf_le_right Va Vb y).2⟩), exact nin h } },
  { simp only [add_mul, map_add, pi.add_apply, ring_hom.map_mul, ext_iff_val, add_val],
    obtain ⟨nin1, hy1⟩ := (wa (opens.inf_le_left Va Vb y)),
    obtain ⟨nin2, hy2⟩ := (wb (opens.inf_le_right Va Vb y)),
    dsimp only at hy1 hy2,
    erw [hy1, hy2],
    simpa only [val_mk', add_mk, ← subtype.val_eq_coe, add_comm], }
end

lemma neg_mem' (U : (opens (projective_spectrum.Top 𝒜))ᵒᵖ)
  (a : Π x : unop U, at x.1)
  (ha : (is_locally_fraction 𝒜).pred a) :
  (is_locally_fraction 𝒜).pred (-a) := λ x,
begin
  rcases ha x with ⟨V, m, i, j, ⟨r, r_mem⟩, ⟨s, s_mem⟩, w⟩,
  choose nin hy using w,
  refine ⟨V, m, i, j, ⟨-r, submodule.neg_mem _ r_mem⟩, ⟨s, s_mem⟩, λ y, ⟨nin y, _⟩⟩,
  simp only [ext_iff_val, val_mk', ←subtype.val_eq_coe] at hy,
  simp only [pi.neg_apply, ext_iff_val, neg_val, hy, val_mk', ←subtype.val_eq_coe, neg_mk],
end

lemma mul_mem' (U : (opens (projective_spectrum.Top 𝒜))ᵒᵖ)
  (a b : Π x : unop U, at x.1)
  (ha : (is_locally_fraction 𝒜).pred a) (hb : (is_locally_fraction 𝒜).pred b) :
  (is_locally_fraction 𝒜).pred (a * b) := λ x,
begin
  rcases ha x with ⟨Va, ma, ia, ja, ⟨ra, ra_mem⟩, ⟨sa, sa_mem⟩, wa⟩,
  rcases hb x with ⟨Vb, mb, ib, jb, ⟨rb, rb_mem⟩, ⟨sb, sb_mem⟩, wb⟩,
  refine ⟨Va ⊓ Vb, ⟨ma, mb⟩, opens.inf_le_left _ _ ≫ ia, ja + jb,
    ⟨ra * rb, set_like.graded_monoid.mul_mem ra_mem rb_mem⟩,
    ⟨sa * sb, set_like.graded_monoid.mul_mem sa_mem sb_mem⟩, λ y, ⟨λ h, _, _⟩⟩,
  { cases (y : projective_spectrum.Top 𝒜).is_prime.mem_or_mem h with h h,
    { choose nin hy using wa ⟨y, (opens.inf_le_left Va Vb y).2⟩, exact nin h },
    { choose nin hy using wb ⟨y, (opens.inf_le_right Va Vb y).2⟩, exact nin h }, },
  { simp only [pi.mul_apply, ring_hom.map_mul],
    choose nin1 hy1 using wa (opens.inf_le_left Va Vb y),
    choose nin2 hy2 using wb (opens.inf_le_right Va Vb y),
    rw ext_iff_val at hy1 hy2 ⊢,
    erw [mul_val, hy1, hy2],
    simpa only [val_mk', mk_mul, ← subtype.val_eq_coe] }
end

end section_subring

section

open section_subring

variable {𝒜}
/--The functions satisfying `is_locally_fraction` form a subring of all dependent functions
`Π x : U, homogeneous_localization 𝒜 x`.-/
def sections_subring (U : (opens (projective_spectrum.Top 𝒜))ᵒᵖ) : subring (Π x : unop U, at x.1) :=
{ carrier := { f | (is_locally_fraction 𝒜).pred f },
  zero_mem' := zero_mem' U,
  one_mem' := one_mem' U,
  add_mem' := add_mem' U,
  neg_mem' := neg_mem' U,
  mul_mem' := mul_mem' U }

end

/--The structure sheaf (valued in `Type`, not yet `CommRing`) is the subsheaf consisting of
functions satisfying `is_locally_fraction`.-/
def structure_sheaf_in_Type : sheaf Type* (projective_spectrum.Top 𝒜):=
subsheaf_to_Types (is_locally_fraction 𝒜)

instance comm_ring_structure_sheaf_in_Type_obj (U : (opens (projective_spectrum.Top 𝒜))ᵒᵖ) :
  comm_ring ((structure_sheaf_in_Type 𝒜).1.obj U) := (sections_subring U).to_comm_ring

/--The structure presheaf, valued in `CommRing`, constructed by dressing up the `Type` valued
structure presheaf.-/
@[simps] def structure_presheaf_in_CommRing : presheaf CommRing (projective_spectrum.Top 𝒜) :=
{ obj := λ U, CommRing.of ((structure_sheaf_in_Type 𝒜).1.obj U),
  map := λ U V i,
  { to_fun := ((structure_sheaf_in_Type 𝒜).1.map i),
    map_zero' := rfl,
    map_add' := λ x y, rfl,
    map_one' := rfl,
    map_mul' := λ x y, rfl, }, }

/--Some glue, verifying that that structure presheaf valued in `CommRing` agrees with the `Type`
valued structure presheaf.-/
def structure_presheaf_comp_forget :
  structure_presheaf_in_CommRing 𝒜 ⋙ (forget CommRing) ≅ (structure_sheaf_in_Type 𝒜).1 :=
nat_iso.of_components (λ U, iso.refl _) (by tidy)

end projective_spectrum.structure_sheaf

namespace projective_spectrum

open Top.presheaf projective_spectrum.structure_sheaf opens

/--The structure sheaf on `Proj` 𝒜, valued in `CommRing`.-/
def Proj.structure_sheaf : sheaf CommRing (projective_spectrum.Top 𝒜) :=
⟨structure_presheaf_in_CommRing 𝒜,
  -- We check the sheaf condition under `forget CommRing`.
  (is_sheaf_iff_is_sheaf_comp _ _).mpr
    (is_sheaf_of_iso (structure_presheaf_comp_forget 𝒜).symm
      (structure_sheaf_in_Type 𝒜).property)⟩

end projective_spectrum

section

open projective_spectrum projective_spectrum.structure_sheaf opens

@[simp] lemma res_apply (U V : opens (projective_spectrum.Top 𝒜)) (i : V ⟶ U)
  (s : (Proj.structure_sheaf 𝒜).1.obj (op U)) (x : V) :
  ((Proj.structure_sheaf 𝒜).1.map i.op s).1 x = (s.1 (i x) : _) :=
rfl

/--`Proj` of a graded ring as a `SheafedSpace`-/
def Proj.to_SheafedSpace : SheafedSpace CommRing :=
{ carrier := Top.of (projective_spectrum 𝒜),
  presheaf := (Proj.structure_sheaf 𝒜).1,
  is_sheaf := (Proj.structure_sheaf 𝒜).2 }

/-- The ring homomorphism that takes a section of the structure sheaf of `Proj` on the open set `U`,
implemented as a subtype of dependent functions to localizations at homogeneous prime ideals, and
evaluates the section on the point corresponding to a given homogeneous prime ideal. -/
def open_to_localization (U : opens (projective_spectrum.Top 𝒜)) (x : projective_spectrum.Top 𝒜)
  (hx : x ∈ U) :
  (Proj.structure_sheaf 𝒜).1.obj (op U) ⟶ CommRing.of (at x) :=
{ to_fun := λ s, (s.1 ⟨x, hx⟩ : _),
  map_one' := rfl,
  map_mul' := λ _ _, rfl,
  map_zero' := rfl,
  map_add' := λ _ _, rfl }

/-- The ring homomorphism from the stalk of the structure sheaf of `Proj` at a point corresponding
to a homogeneous prime ideal `x` to the *homogeneous localization* at `x`,
formed by gluing the `open_to_localization` maps. -/
def stalk_to_fiber_ring_hom (x : projective_spectrum.Top 𝒜) :
  (Proj.structure_sheaf 𝒜).1.stalk x ⟶ CommRing.of (at x) :=
limits.colimit.desc (((open_nhds.inclusion x).op) ⋙ (Proj.structure_sheaf 𝒜).1)
  { X := _,
    ι :=
    { app := λ U, open_to_localization 𝒜 ((open_nhds.inclusion _).obj (unop U)) x (unop U).2, } }

@[simp] lemma germ_comp_stalk_to_fiber_ring_hom (U : opens (projective_spectrum.Top 𝒜)) (x : U) :
  (Proj.structure_sheaf 𝒜).1.germ x ≫ stalk_to_fiber_ring_hom 𝒜 x =
  open_to_localization 𝒜 U x x.2 :=
limits.colimit.ι_desc _ _

@[simp] lemma stalk_to_fiber_ring_hom_germ' (U : opens (projective_spectrum.Top 𝒜))
  (x : projective_spectrum.Top 𝒜) (hx : x ∈ U) (s : (Proj.structure_sheaf 𝒜).1.obj (op U)) :
  stalk_to_fiber_ring_hom 𝒜 x ((Proj.structure_sheaf 𝒜).1.germ ⟨x, hx⟩ s) = (s.1 ⟨x, hx⟩ : _) :=
ring_hom.ext_iff.1 (germ_comp_stalk_to_fiber_ring_hom 𝒜 U ⟨x, hx⟩ : _) s

@[simp] lemma stalk_to_fiber_ring_hom_germ (U : opens (projective_spectrum.Top 𝒜)) (x : U)
  (s : (Proj.structure_sheaf 𝒜).1.obj (op U)) :
  stalk_to_fiber_ring_hom 𝒜 x ((Proj.structure_sheaf 𝒜).1.germ x s) = s.1 x :=
by { cases x, exact stalk_to_fiber_ring_hom_germ' 𝒜 U _ _ _ }

lemma homogeneous_localization.mem_basic_open (x : projective_spectrum.Top 𝒜) (f : at x) :
  x ∈ projective_spectrum.basic_open 𝒜 f.denom :=
begin
  rw projective_spectrum.mem_basic_open,
  exact homogeneous_localization.denom_not_mem _,
end

variable (𝒜)

/--Given a point `x` corresponding to a homogeneous prime ideal, there is a (dependent) function
such that, for any `f` in the homogeneous localization at `x`, it returns the obvious section in the
basic open set `D(f.denom)`-/
def section_in_basic_open (x : projective_spectrum.Top 𝒜) :
  Π (f : at x),
    (Proj.structure_sheaf 𝒜).1.obj (op (projective_spectrum.basic_open 𝒜 f.denom)) :=
λ f, ⟨λ y, quotient.mk' ⟨f.deg, ⟨f.num, f.num_mem⟩, ⟨f.denom, f.denom_mem⟩, y.2⟩,
  λ y, ⟨projective_spectrum.basic_open 𝒜 f.denom, y.2,
    ⟨𝟙 _, ⟨f.deg, ⟨⟨f.num, f.num_mem⟩, ⟨f.denom, f.denom_mem⟩,
      λ z, ⟨z.2, rfl⟩⟩⟩⟩⟩⟩

/--Given any point `x` and `f` in the homogeneous localizatoin at `x`, there is an element in the
stalk at `x` obtained by `section_in_basic_open`. This is the inverse of `stalk_to_fiber_ring_hom`.
-/
def homogeneous_localization_to_stalk (x : projective_spectrum.Top 𝒜) :
  (at x) → (Proj.structure_sheaf 𝒜).1.stalk x :=
λ f, (Proj.structure_sheaf 𝒜).1.germ
  (⟨x, homogeneous_localization.mem_basic_open _ x f⟩ : projective_spectrum.basic_open _ f.denom)
  (section_in_basic_open _ x f)

/--Using `homogeneous_localization_to_stalk`, we construct a ring isomorphism between stalk at `x`
and homogeneous localization at `x` for any point `x` in `Proj`.-/
def Proj.stalk_iso' (x : projective_spectrum.Top 𝒜) :
  (Proj.structure_sheaf 𝒜).1.stalk x ≃+* CommRing.of (at x)  :=
ring_equiv.of_bijective (stalk_to_fiber_ring_hom _ x)
⟨λ z1 z2 eq1, begin
  obtain ⟨u1, memu1, s1, rfl⟩ := (Proj.structure_sheaf 𝒜).1.germ_exist x z1,
  obtain ⟨u2, memu2, s2, rfl⟩ := (Proj.structure_sheaf 𝒜).1.germ_exist x z2,
  obtain ⟨v1, memv1, i1, ⟨j1, ⟨a1, a1_mem⟩, ⟨b1, b1_mem⟩, hs1⟩⟩ := s1.2 ⟨x, memu1⟩,
  obtain ⟨v2, memv2, i2, ⟨j2, ⟨a2, a2_mem⟩, ⟨b2, b2_mem⟩, hs2⟩⟩ := s2.2 ⟨x, memu2⟩,
  obtain ⟨b1_nin_x, eq2⟩ := hs1 ⟨x, memv1⟩,
  obtain ⟨b2_nin_x, eq3⟩ := hs2 ⟨x, memv2⟩,
  dsimp only at eq1 eq2 eq3,
  erw [stalk_to_fiber_ring_hom_germ 𝒜 u1 ⟨x, memu1⟩ s1,
    stalk_to_fiber_ring_hom_germ 𝒜 u2 ⟨x, memu2⟩ s2] at eq1,
  erw eq1 at eq2,
  erw [eq2, quotient.eq] at eq3,
  change localization.mk _ _ = localization.mk _ _ at eq3,
  rw [localization.mk_eq_mk', is_localization.eq] at eq3,
  obtain ⟨⟨c, hc⟩, eq3⟩ := eq3,
  simp only [← subtype.val_eq_coe] at eq3,
  have eq3' : ∀ (y : projective_spectrum.Top 𝒜)
    (hy : y ∈ projective_spectrum.basic_open 𝒜 b1 ⊓
      projective_spectrum.basic_open 𝒜 b2 ⊓
      projective_spectrum.basic_open 𝒜 c),
    (localization.mk a1
      ⟨b1, show b1 ∉ y.as_homogeneous_ideal,
        by rw ←projective_spectrum.mem_basic_open;
          exact le_of_hom (opens.inf_le_left _ _ ≫ opens.inf_le_left _ _) hy⟩ :
            localization.at_prime y.1.to_ideal) =
    localization.mk a2
      ⟨b2, show b2 ∉ y.as_homogeneous_ideal,
        by rw ←projective_spectrum.mem_basic_open;
        exact le_of_hom (opens.inf_le_left _ _ ≫ opens.inf_le_right _ _) hy⟩,
  { intros y hy,
    rw [localization.mk_eq_mk', is_localization.eq],
    exact ⟨⟨c, show c ∉ y.as_homogeneous_ideal, by rw ←projective_spectrum.mem_basic_open;
      exact le_of_hom (opens.inf_le_right _ _) hy⟩, eq3⟩ },
  refine presheaf.germ_ext (Proj.structure_sheaf 𝒜).1
    (projective_spectrum.basic_open _ b1 ⊓
      projective_spectrum.basic_open _ b2 ⊓
      projective_spectrum.basic_open _ c ⊓ v1 ⊓ v2)
    ⟨⟨⟨⟨b1_nin_x, b2_nin_x⟩, hc⟩, memv1⟩, memv2⟩
    (opens.inf_le_left _ _ ≫ opens.inf_le_right _ _ ≫ i1) (opens.inf_le_right _ _ ≫ i2) _,
  rw subtype.ext_iff_val,
  ext1 y,
  simp only [res_apply],
  obtain ⟨b1_nin_y, eq6⟩ := hs1 ⟨_, le_of_hom (opens.inf_le_left _ _ ≫ opens.inf_le_right _ _) y.2⟩,
  obtain ⟨b2_nin_y, eq7⟩ := hs2 ⟨_, le_of_hom (opens.inf_le_right _ _) y.2⟩,
  simp only at eq6 eq7,
  erw [eq6, eq7, quotient.eq],
  change localization.mk _ _ = localization.mk _ _,
  exact eq3' _ ⟨⟨le_of_hom (opens.inf_le_left _ _ ≫ opens.inf_le_left _ _ ≫
      opens.inf_le_left _ _ ≫ opens.inf_le_left _ _) y.2,
    le_of_hom (opens.inf_le_left _ _ ≫ opens.inf_le_left _ _ ≫
      opens.inf_le_left _ _ ≫ opens.inf_le_right _ _) y.2⟩,
    le_of_hom (opens.inf_le_left _ _ ≫ opens.inf_le_left _ _ ≫
      opens.inf_le_right _ _) y.2⟩,
end, function.surjective_iff_has_right_inverse.mpr ⟨homogeneous_localization_to_stalk 𝒜 x,
  λ f, begin
    rw homogeneous_localization_to_stalk,
    erw stalk_to_fiber_ring_hom_germ 𝒜
      (projective_spectrum.basic_open 𝒜 f.denom) ⟨x, _⟩ (section_in_basic_open _ x f),
    simp only [section_in_basic_open, subtype.ext_iff_val, homogeneous_localization.ext_iff_val,
      homogeneous_localization.val_mk', f.eq_num_div_denom],
    refl,
  end⟩⟩

/--`Proj` of a graded ring as a `LocallyRingedSpace`-/
def Proj.to_LocallyRingedSpace : LocallyRingedSpace :=
{ local_ring := λ x, @@ring_equiv.local_ring _
    (show local_ring (at x), from infer_instance) _
    (Proj.stalk_iso' 𝒜 x).symm,
  ..(Proj.to_SheafedSpace 𝒜) }

end

end algebraic_geometry


import vorspiel landau_notation boolean_logic binary_recursion

universes u v

inductive circuit : ℕ → ℕ → Type
| relay    {n}     : fin n → circuit n 1 -- id gate
| not      {n}     : fin n → circuit n 1 -- NOT disjunction
| and      {n}     : finset (fin n) → circuit n 1 -- AND conjunction
| or       {n}     : finset (fin n) → circuit n 1 -- OR disjunction
| parallel {n m k} : circuit n m → circuit n k → circuit n (k + m)
| serial   {n m k} : circuit n m → circuit m k → circuit n k

infixl ` ∥ `: 70 := circuit.parallel

infixl ` ▷ `: 70 := circuit.serial

namespace circuit

@[simp] def size : ∀ {n m}, circuit n m → ℕ
| _ _ (relay i) := 0
| _ _ (not i)   := 1
| _ _ (and s)   := 1
| _ _ (or s)    := 1
| _ _ (c₁ ∥ c₂) := c₁.size + c₂.size
| _ _ (c₁ ▷ c₂) := c₁.size + c₂.size

@[simp] def depth : ∀ {n m}, circuit n m → ℕ
| _ _ (relay i) := 0
| _ _ (not i)   := 1
| _ _ (and s)   := 1
| _ _ (or s)    := 1
| _ _ (c₁ ∥ c₂) := max c₁.depth c₂.depth
| _ _ (c₁ ▷ c₂) := c₁.depth + c₂.depth

lemma depth_le_size : ∀ {n m} (c : circuit n m), c.depth ≤ c.size
| _ _ (relay i) := by simp
| _ _ (not i)   := by simp
| _ _ (and s)   := by simp
| _ _ (or s)    := by simp
| _ _ (c₁ ∥ c₂) := by simp; exact ⟨le_add_right (depth_le_size c₁), le_add_left (depth_le_size c₂)⟩
| _ _ (c₁ ▷ c₂) := by simp; exact add_le_add (depth_le_size c₁) (depth_le_size c₂)

@[simp] def eval : Π {n m}, circuit n m → 𝕓 n → 𝕓 m
| _ _ (relay i) d := d.nth i
| _ _ (not i)   d := bnot (d.nth i)
| _ _ (and s)   d := ↑(s.inf d.nth)
| _ _ (or s)    d := ↑(s.sup d.nth)
| _ _ (c₁ ∥ c₂) d := (c₁.eval d) ++ᵥ (c₂.eval d)
| _ _ (c₁ ▷ c₂) d := c₂.eval (c₁.eval d)

def val {n} (c : circuit n 1) (v : 𝕓 n) : bool := (c.eval v).head

@[simp] def bounded (b : ℕ) : ∀ {n m}, circuit n m → Prop
| _ _ (relay i) := true
| _ _ (not i)   := true
| _ _ (and s)   := s.card ≤ b
| _ _ (or s)    := s.card ≤ b
| _ _ (c₁ ∥ c₂) := c₁.bounded ∧ c₂.bounded
| _ _ (c₁ ▷ c₂) := c₁.bounded ∧ c₂.bounded

section map

@[simp] def map : ∀ {n n' m} (f : fin n → fin n'), circuit n m → circuit n' m
| _ _ _ f (relay i) := relay (f i)
| _ _ _ f (not i)   := not (f i)
| _ _ _ f (and s)   := and (s.image f)
| _ _ _ f (or s)    := or (s.image f)
| _ _ _ f (c₁ ∥ c₂) := parallel (c₁.map f) (c₂.map f)
| _ _ _ f (c₁ ▷ c₂) := serial (c₁.map f) c₂

@[simp] lemma map_size : ∀ {n n' m} (f : fin n → fin n') (c : circuit n m), (c.map f).size = c.size
| _ _ _ f (relay i) := by simp
| _ _ _ f (not i)   := by simp
| _ _ _ f (and s)   := by simp
| _ _ _ f (or s)    := by simp
| _ _ _ f (c₁ ∥ c₂) := by simp[map_size f c₁, map_size f c₂]
| _ _ _ f (c₁ ▷ c₂) := by simp[map_size f c₁]

@[simp] lemma map_depth : ∀ {n n' m} (f : fin n → fin n') (c : circuit n m), (c.map f).depth = c.depth
| _ _ _ f (relay i) := by simp
| _ _ _ f (not i)   := by simp
| _ _ _ f (and s)   := by simp
| _ _ _ f (or s)    := by simp
| _ _ _ f (c₁ ∥ c₂) := by simp[map_depth f c₁, map_depth f c₂]
| _ _ _ f (c₁ ▷ c₂) := by simp[map_depth f c₁]

lemma map_eval : ∀ {n n' m} (f : fin n → fin n') (c : circuit n m) (v),
  (c.map f).eval v = c.eval (vector.of_fn $ λ i, v.nth (f i))
| _ _ _ f (relay i) v := by simp
| _ _ _ f (not i)   v := by simp
| _ _ _ f (and s)   v := by simp[finset.inf_image]; refine congr_arg _ (funext $ by simp)
| _ _ _ f (or s)    v := by simp[finset.sup_image]; refine congr_arg _ (funext $ by simp)
| _ _ _ f (c₁ ∥ c₂) v := by simp[map_eval f c₁, map_eval f c₂]
| _ _ _ f (c₁ ▷ c₂) v := by simp[map_eval f c₁]

@[simp] lemma map_bounded (b) : ∀ {n n' m} (f : fin n → fin n') (c : circuit n m), c.bounded b → (c.map f).bounded b
| _ _ _ f (relay i) h := by simp
| _ _ _ f (not i)   h := by simp
| _ _ _ f (and s)   h := le_trans finset.card_image_le h
| _ _ _ f (or s)    h := le_trans finset.card_image_le h
| _ _ _ f (c₁ ∥ c₂) h := ⟨map_bounded f c₁ h.1, map_bounded f c₂ h.2⟩
| _ _ _ f (c₁ ▷ c₂) h := ⟨map_bounded f c₁ h.1, h.2⟩

end map

section disjoint_parallel
variables {n₁ n₂ m₁ m₂ : ℕ} (c₁ : circuit n₁ m₁) (c₂ : circuit n₂ m₂)

def disjoint_parallel : circuit (n₂ + n₁) (m₂ + m₁) :=
let c'₁ : circuit (n₂ + n₁) m₁ := c₁.map (λ i, ⟨i, nat.lt_add_left _ _ _ i.property⟩),
    c'₂ : circuit (n₂ + n₁) m₂ := c₂.map (λ i, ⟨n₁ + i, by simp[add_comm]⟩) in
c'₁ ∥ c'₂

infixl ` |+| `:65 := disjoint_parallel

@[simp] lemma disjoint_parallel_size : (c₁ |+| c₂).size = c₁.size + c₂.size := by simp[(|+|)]

@[simp] lemma disjoint_parallel_depth : (c₁ |+| c₂).depth = max c₁.depth c₂.depth := by simp[(|+|)]

@[simp] lemma disjoint_parallel_eval_append (v₁ : 𝕓 n₁) (v₂ : 𝕓 n₂) :
  (c₁ |+| c₂).eval (v₁ ++ᵥ v₂) = c₁.eval v₁ ++ᵥ c₂.eval v₂ :=
by simp[(|+|), map_eval]

@[simp] lemma disjoint_parallel_eval_cons {n} (c₁ : circuit 1 m₁) (c₂ : circuit n m₂) (b : bool) (v : 𝕓 n) :
  (c₁ |+| c₂).eval (b ::ᵥ v) = c₁.eval b ++ᵥ c₂.eval v :=
by { have : b ::ᵥ v = (b : 𝕓 1) ++ᵥ v, by simp[vector.coe_succ],
     simp[this] }

end disjoint_parallel

section gate
variables {n : ℕ}

section

def andl (i j : fin n) : circuit n 1 := and {i, j}

def orl (i j : fin n) : circuit n 1 := or {i, j}

@[simp] lemma andl_bounded {i j : fin n} : bounded 2 (andl i j) := by simpa using finset.card_insert_le i {j}

@[simp] lemma orl_bounded {i j : fin n} : bounded 2 (orl i j) := by simpa using finset.card_insert_le i {j}

@[simp] lemma andl_eval (i j : fin n) (v) : (andl i j).eval v = v.nth i && v.nth j := by simp[andl]

@[simp] lemma orl_eval (i j : fin n) (v) : (orl i j).eval v = v.nth i || v.nth j := by simp[orl]

@[simp] lemma andl_size (i j : fin n) : (andl i j).size = 1 := by simp[andl]

@[simp] lemma orl_size (i j : fin n) : (orl i j).size = 1 := by simp[orl]

@[simp] lemma andl_depth (i j : fin n) : (andl i j).depth = 1 := by simp[andl]

@[simp] lemma orl_depth (i j : fin n) : (orl i j).depth = 1 := by simp[orl]

end

section conj

def conj : circuit 2 1 := and {0, 1}

@[simp] lemma conj_size : (conj : circuit 2 1).size = 1 := by simp[conj]

@[simp] lemma conj_depth : (conj : circuit 2 1).depth = 1 := by simp[conj]

@[simp] lemma conj_eval (v) : (conj : circuit 2 1).eval v = v.inf := by simp[conj]

end conj

section disj

def disj : circuit 2 1 := or {0, 1}

@[simp] lemma disj_size : (disj : circuit 2 1).size = 1 := by simp[disj]

@[simp] lemma disj_depth : (disj : circuit 2 1).depth = 1 := by simp[disj]

@[simp] lemma disj_eval (v) : (disj : circuit 2 1).eval v = v.sup := by simp[disj]

end disj

section relay'

def relay' : circuit 1 1 := relay 0

@[simp] lemma relay'_size : (relay' : circuit 1 1).size = 0 := by simp[relay']

@[simp] lemma relay'_depth : (relay' : circuit 1 1).depth = 0 := by simp[relay']

@[simp] lemma relay'_eval (v) : (relay' : circuit 1 1).eval v = v := by simp[relay']

end relay'

section

def zero_tt (n : ℕ) : circuit n 1 := and ∅

instance : has_top (circuit n 1) := ⟨zero_tt n⟩

def zero_ff (n : ℕ) : circuit n 1 := or ∅

instance : has_bot (circuit n 1) := ⟨zero_ff n⟩

@[simp] lemma top_bounded (k) : (⊤ : circuit n 1).bounded k := by unfold has_top.top; simp[zero_tt]

@[simp] lemma bot_bounded (k) : (⊥ : circuit n 1).bounded k := by unfold has_bot.bot; simp[zero_ff]

@[simp] lemma top_eval (v) : (⊤ : circuit n 1).eval v = tt := by unfold has_top.top; simp[zero_tt]

@[simp] lemma bot_eval (v) : (⊥ : circuit n 1).eval v = ff := by unfold has_bot.bot; simp[zero_ff]

@[simp] lemma top_size : (⊤ : circuit n 1).size = 1 := by unfold has_top.top; simp[zero_tt]

@[simp] lemma bot_size : (⊥ : circuit n 1).size = 1 := by unfold has_bot.bot; simp[zero_ff]

@[simp] lemma top_depth : (⊤ : circuit n 1).depth = 1 := by unfold has_top.top; simp[zero_tt]

@[simp] lemma bot_depth : (⊥ : circuit n 1).depth = 1 := by unfold has_bot.bot; simp[zero_ff]

end

section bounded_and

def bounded_and : Π n, circuit n 1 := nat.binary_recursion ⊤
  (λ n hn c, (c |+| c) ▷ conj)
  (λ n c, (relay' |+| (c |+| c) ▷ conj) ▷ conj)

lemma bounded_and_bit0 {n : ℕ} (h : n ≠ 0) : bounded_and (bit0 n) = (bounded_and n |+| bounded_and n) ▷ conj :=
nat.binary_recursion_bit0_eq h

lemma bounded_and_bit1 (n) : bounded_and (bit1 n) = (relay' |+| (bounded_and n |+| bounded_and n) ▷ conj) ▷ conj:=
nat.binary_recursion_bit1_eq n

lemma bounded_and_eval : ∀ n (v : 𝕓 n), (bounded_and n).eval v = v.inf :=
nat.binary_recursion (by simp[bounded_and])
  (λ n hn IH v, by {
    rw ←vector.append'_half_even v,
    simp[bounded_and_bit0 hn, IH, vector.coe_succ] })
  (λ n IH v, by {
    rw [←vector.append'_half_odd v, bounded_and_bit1 n],
    simp[bounded_and_bit1, IH] })

open landau_notation

lemma bounded_and_size : O[λ n, (bounded_and n).size] ≤ bigΘ.poly 1 :=
le_poly1_of_binary_rec _ 2 (λ b n, by {
  rcases b,
  { by_cases hn : n = 0,
    { rw[hn, show nat.bit ff 0 = 0, by simp[nat.bit_ff]], simp[bounded_and], omega },
    { rw[show nat.bit ff n = bit0 n, by refl, bounded_and_bit0 hn], simp[two_mul] } },
  { rw[show nat.bit tt n = bit1 n, by refl, bounded_and_bit1], simp[two_mul] } })

lemma bounded_and_depth : O[λ n, (bounded_and n).depth] ≤ bigΘ.Log :=
le_Log_of_binary_rec _ 2 (λ b n, by {
  rcases b,
  { by_cases hn : n = 0,
    { rw[hn, show nat.bit ff 0 = 0, by simp[nat.bit_ff]], simp[bounded_and] },
    { rw[show nat.bit ff n = bit0 n, by refl, bounded_and_bit0 hn], simp } },
  { rw[show nat.bit tt n = bit1 n, by refl, bounded_and_bit1], simp } })

end bounded_and

section bounded_or

def bounded_or : Π n, circuit n 1 := nat.binary_recursion ⊥
  (λ n hn c, (c |+| c) ▷ disj)
  (λ n c, (relay' |+| (c |+| c) ▷ disj) ▷ disj)

lemma bounded_or_bit0 {n : ℕ} (h : n ≠ 0) : bounded_or (bit0 n) = (bounded_or n |+| bounded_or n) ▷ disj :=
nat.binary_recursion_bit0_eq h

lemma bounded_or_bit1 (n) : bounded_or (bit1 n) = (relay' |+| (bounded_or n |+| bounded_or n) ▷ disj) ▷ disj:=
nat.binary_recursion_bit1_eq n

lemma bounded_or_eval : ∀ n (v : 𝕓 n), (bounded_or n).eval v = v.sup :=
nat.binary_recursion (by simp[bounded_or])
  (λ n hn IH v, by {
    rw ←vector.append'_half_even v,
    simp[bounded_or_bit0 hn, IH, vector.coe_succ] })
  (λ n IH v, by {
    rw [←vector.append'_half_odd v, bounded_or_bit1 n],
    simp[bounded_or_bit1, IH] })

open landau_notation

lemma bounded_or_size : O[λ n, (bounded_or n).size] ≤ bigΘ.poly 1 :=
le_poly1_of_binary_rec _ 2 (λ b n, by {
  rcases b,
  { by_cases hn : n = 0,
    { rw[hn, show nat.bit ff 0 = 0, by simp[nat.bit_ff]], simp[bounded_or], omega },
    { rw[show nat.bit ff n = bit0 n, by refl, bounded_or_bit0 hn], simp[two_mul] } },
  { rw[show nat.bit tt n = bit1 n, by refl, bounded_or_bit1], simp[two_mul] } })

lemma bounded_or_depth : O[λ n, (bounded_or n).depth] ≤ bigΘ.Log :=
le_Log_of_binary_rec _ 2 (λ b n, by {
  rcases b,
  { by_cases hn : n = 0,
    { rw[hn, show nat.bit ff 0 = 0, by simp[nat.bit_ff]], simp[bounded_or] },
    { rw[show nat.bit ff n = bit0 n, by refl, bounded_or_bit0 hn], simp } },
  { rw[show nat.bit tt n = bit1 n, by refl, bounded_or_bit1], simp } })

end bounded_or

end gate

end circuit


-- Copyright (c) 2019 Jesse Han. All rights reserved.
-- Released under Apache 2.0 license as described in the file LICENSE.
-- Authors: Jesse Han

import .finite_limits

open category_theory category_theory.limits category_theory.limits.binary_product
     category_theory.limits.finite_limits

universes v u

local infix ` × `:60 := binary_product
local infix ` ×.map `:90 := binary_product.map
local infix ` ×.iso `:90 := binary_product.iso

/-- A group object in a category with finite products is an object `G` equipped with morphisms
  `μ : G × G ⟶ G`, `e : 1 ⟶ G` and `i : G ⟶ G` such that the axioms for a group hold
  (which is expressed in terms of commuting diagrams) -/
structure group_object (C : Type u) [𝓒 : category.{v+1} C] [H : has_binary_products.{v} C]
  [H' : has_terminal_object.{v} C]  : Type (max u v) :=
(obj : C)
(mul : obj × obj ⟶ obj)
(mul_assoc : assoc_hom ≫ 𝟙 obj ×.map mul ≫ mul = mul ×.map 𝟙 obj ≫ mul)
(one : term ⟶ obj)
(one_mul : 𝟙 obj = one_mul_inv ≫ one ×.map 𝟙 obj ≫ mul)
(mul_one : 𝟙 obj = mul_one_inv ≫ 𝟙 obj ×.map one ≫ mul)
(inv : obj ⟶ obj)
(mul_left_inv : terminal_map _ ≫ one = map_to_product.mk inv (𝟙 obj) ≫ mul)

/-- A morphism between group objects is a morphism between the objects that commute with
  multiplication -/
structure group_hom {C : Type u} [category.{v+1} C] [has_binary_products C]
  [has_terminal_object C] (G G' : group_object C) : Type (max u v) :=
(map : G.obj ⟶ G'.obj)
(map_mul : G.mul ≫ map = map ×.map map ≫ G'.mul)

/- An action of a group object on any object in the category -/
structure group_action {C : Type u} [category.{v+1} C] [has_binary_products C]
  [has_terminal_object C] (G : group_object C) (X : C) : Type (max u v) :=
(map : G.obj × X ⟶ X)
(map_one : map_to_product.mk (terminal_map X ≫ G.one) (𝟙 X) ≫ map = 𝟙 X)
(map_mul : G.mul ×.map 𝟙 X ≫ map = assoc_hom ≫ 𝟙 G.obj ×.map map ≫ map)

variables {C : Type u} [𝓒 : category.{v+1} C] [p𝓒 : has_binary_products.{v} C]
  [t𝓒 : has_terminal_object.{v} C] {X Y : C} {G G' G₁ G₂ G₃ H : group_object C}
include 𝓒 p𝓒 t𝓒

namespace group_hom

/-- The identity morphism between group objects -/
def id (G : group_object C) : group_hom G G :=
⟨𝟙 G.obj, omitted⟩

/-- Composition of morphisms between group objects -/
def comp (f : group_hom G₁ G₂) (g : group_hom G₂ G₃) : group_hom G₁ G₃ :=
⟨f.map ≫ g.map, omitted⟩

lemma map_one (f : group_hom G G') : G.one ≫ f.map = G'.one := omitted
lemma map_inv (f : group_hom G G') : G.inv ≫ f.map = f.map ≫ G'.inv := omitted

end group_hom

namespace group_object

/-- The category of group objects -/
instance category : category (group_object C) :=
{ hom := group_hom,
  id := group_hom.id,
  comp := λ X Y Z, group_hom.comp }

/-- The terminal group object -/
def terminal_group : group_object C :=
{ obj := term,
  mul := terminal_map _,
  mul_assoc := terminal_map_eq _ _,
  one := terminal_map _,
  one_mul := terminal_map_eq _ _,
  mul_one := terminal_map_eq _ _,
  inv := terminal_map _,
  mul_left_inv := terminal_map_eq _ _ }

/-- The morphism into the terminal group object -/
def hom_terminal_group (G : group_object C) : G ⟶ terminal_group :=
by exact ⟨terminal_map G.obj, omitted⟩

/-- The category of group objects has a terminal object -/
instance has_terminal_object : has_terminal_object (group_object C) :=
has_terminal_object.mk terminal_group hom_terminal_group omitted

/-- The binary product of group objects -/
protected def prod (G G' : group_object C) : group_object C :=
{ obj := G.obj × G'.obj,
  mul := product_assoc4.hom ≫ G.mul ×.map G'.mul,
  mul_assoc := omitted,
  one := map_to_product.mk G.one G'.one,
  one_mul := omitted,
  mul_one := omitted,
  inv := G.inv ×.map G'.inv,
  mul_left_inv := omitted }

protected def pr1 : G.prod G' ⟶ G := by exact ⟨π₁, omitted⟩
protected def pr2 : G.prod G' ⟶ G' := by exact ⟨π₂, omitted⟩
protected def lift (f : H ⟶ G) (g : H ⟶ G') : H ⟶ G.prod G' :=
by exact ⟨map_to_product.mk f.map g.map, omitted⟩

/-- The category of group objects has binary products -/
instance has_binary_products : has_binary_products (group_object C) :=
begin
  apply has_binary_products.mk group_object.prod (λ G G', group_object.pr1)
    (λ G G', group_object.pr2) (λ G G' H, group_object.lift),
  omit_proofs
end

/-- Every group object has a point, i.e. a morphism from the terminal object -/
def one_hom (G : group_object C) : term ⟶ G :=
by exact ⟨G.one, omitted⟩

omit 𝓒 p𝓒 t𝓒
/-- A group object is abelian if multiplication is commutative -/
-- todo: maybe this should be a class
class is_abelian {C : Type u} [𝓒 : category.{v+1} C] [H : has_binary_products.{v} C]
  [H' : has_terminal_object.{v} C] (G : group_object C) : Prop :=
(comm : product_comm.hom ≫ G.mul = G.mul)
include 𝓒 p𝓒 t𝓒

/-- Multiplication is a group homomorphism if `G` is abelian -/
def mul_hom (G : group_object C) [G.is_abelian] : G × G ⟶ G :=
by exact ⟨G.mul, omitted⟩

/-- Inversion is a group homomorphism if `G` is abelian -/
def inv_hom (G : group_object C) [G.is_abelian] : G ⟶ G :=
by exact ⟨G.inv, omitted⟩

instance comm_group_hom (G G' : group_object C) [G'.is_abelian] : comm_group (G ⟶ G') :=
{ mul := λ f g, map_to_product.mk f g ≫ G'.mul_hom,
  mul_assoc := omitted,
  one := terminal_map G ≫ one_hom G',
  one_mul := omitted,
  mul_one := omitted,
  inv := λ f, f ≫ inv_hom G',
  mul_left_inv := omitted,
  mul_comm := omitted }

end group_object


/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro

! This file was ported from Lean 3 source module order.rel_iso.group
! leanprover-community/mathlib commit 62a5626868683c104774de8d85b9855234ac807c
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Group.Defs
import Mathlib.Order.RelIso.Basic

/-!
# Relation isomorphisms form a group
-/

variable {α : Type _} {r : α → α → Prop}

namespace RelIso

instance : Group (r ≃r r) where
  one := RelIso.refl r
  mul f₁ f₂ := f₂.trans f₁
  inv := RelIso.symm
  mul_assoc f₁ f₂ f₃ := rfl
  one_mul f := ext fun _ => rfl
  mul_one f := ext fun _ => rfl
  mul_left_inv f := ext f.symm_apply_apply

@[simp]
theorem coe_one : ((1 : r ≃r r) : α → α) = id :=
  rfl
#align rel_iso.coe_one RelIso.coe_one

@[simp]
theorem coe_mul (e₁ e₂ : r ≃r r) : ((e₁ * e₂) : α → α) = e₁ ∘ e₂ :=
  rfl
#align rel_iso.coe_mul RelIso.coe_mul

theorem mul_apply (e₁ e₂ : r ≃r r) (x : α) : (e₁ * e₂) x = e₁ (e₂ x) :=
  rfl
#align rel_iso.mul_apply RelIso.mul_apply

@[simp]
theorem inv_apply_self (e : r ≃r r) (x) : e⁻¹ (e x) = x :=
  e.symm_apply_apply x
#align rel_iso.inv_apply_self RelIso.inv_apply_self

@[simp]

end RelIso


/-
Copyright (c) 2019 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl

! This file was ported from Lean 3 source module linear_algebra.finsupp
! leanprover-community/mathlib commit 3dec44d0b621a174c56e994da4aae15ba60110a2
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Finsupp.Defs
import Mathlib.LinearAlgebra.Pi
import Mathlib.LinearAlgebra.Span

/-!
# Properties of the module `α →₀ M`

Given an `R`-module `M`, the `R`-module structure on `α →₀ M` is defined in
`Data.Finsupp.Basic`.

In this file we define `Finsupp.supported s` to be the set `{f : α →₀ M | f.support ⊆ s}`
interpreted as a submodule of `α →₀ M`. We also define `LinearMap` versions of various maps:

* `Finsupp.lsingle a : M →ₗ[R] ι →₀ M`: `Finsupp.single a` as a linear map;
* `Finsupp.lapply a : (ι →₀ M) →ₗ[R] M`: the map `λ f, f a` as a linear map;
* `Finsupp.lsubtypeDomain (s : set α) : (α →₀ M) →ₗ[R] (s →₀ M)`: restriction to a subtype as a
  linear map;
* `Finsupp.restrictDom`: `Finsupp.filter` as a linear map to `Finsupp.supported s`;
* `Finsupp.lsum`: `Finsupp.sum` or `Finsupp.liftAddHom` as a `LinearMap`;
* `Finsupp.total α M R (v : ι → M)`: sends `l : ι → R` to the linear combination of `v i` with
  coefficients `l i`;
* `Finsupp.totalOn`: a restricted version of `Finsupp.total` with domain `Finsupp.supported R R s`
  and codomain `Submodule.span R (v '' s)`;
* `Finsupp.supportedEquivFinsupp`: a linear equivalence between the functions `α →₀ M` supported
  on `s` and the functions `s →₀ M`;
* `Finsupp.lmapDomain`: a linear map version of `Finsupp.mapDomain`;
* `Finsupp.domLCongr`: a `LinearEquiv` version of `Finsupp.domCongr`;
* `Finsupp.congr`: if the sets `s` and `t` are equivalent, then `supported M R s` is equivalent to
  `supported M R t`;
* `Finsupp.lcongr`: a `LinearEquiv`alence between `α →₀ M` and `β →₀ N` constructed using `e : α ≃
  β` and `e' : M ≃ₗ[R] N`.

## Tags

function with finite support, module, linear algebra
-/

noncomputable section

open Set LinearMap Submodule
open Classical BigOperators

namespace Finsupp

variable {α : Type _} {M : Type _} {N : Type _} {P : Type _} {R : Type _} {S : Type _}
variable [Semiring R] [Semiring S] [AddCommMonoid M] [Module R M]
variable [AddCommMonoid N] [Module R N]
variable [AddCommMonoid P] [Module R P]

/-- Interpret `Finsupp.single a` as a linear map. -/
def lsingle (a : α) : M →ₗ[R] α →₀ M :=
  { Finsupp.singleAddHom a with map_smul' := fun _ _ => (smul_single _ _ _).symm }
#align finsupp.lsingle Finsupp.lsingle

/-- Two `R`-linear maps from `Finsupp X M` which agree on each `single x y` agree everywhere. -/
theorem lhom_ext ⦃φ ψ : (α →₀ M) →ₗ[R] N⦄ (h : ∀ a b, φ (single a b) = ψ (single a b)) : φ = ψ :=
  LinearMap.toAddMonoidHom_injective <| addHom_ext h
#align finsupp.lhom_ext Finsupp.lhom_ext

/-- Two `R`-linear maps from `Finsupp X M` which agree on each `single x y` agree everywhere.

We formulate this fact using equality of linear maps `φ.comp (lsingle a)` and `ψ.comp (lsingle a)`
so that the `ext` tactic can apply a type-specific extensionality lemma to prove equality of these
maps. E.g., if `M = R`, then it suffices to verify `φ (single a 1) = ψ (single a 1)`. -/
-- Porting note: The priority should be higher than `LinearMap.ext`.
@[ext high]
theorem lhom_ext' ⦃φ ψ : (α →₀ M) →ₗ[R] N⦄ (h : ∀ a, φ.comp (lsingle a) = ψ.comp (lsingle a)) :
    φ = ψ :=
  lhom_ext fun a => LinearMap.congr_fun (h a)
#align finsupp.lhom_ext' Finsupp.lhom_ext'

/-- Interpret `fun f : α →₀ M ↦ f a` as a linear map. -/
def lapply (a : α) : (α →₀ M) →ₗ[R] M :=
  { Finsupp.applyAddHom a with map_smul' := fun _ _ => rfl }
#align finsupp.lapply Finsupp.lapply

/-- Forget that a function is finitely supported.

This is the linear version of `Finsupp.toFun`. -/
@[simps]
def lcoeFun : (α →₀ M) →ₗ[R] α → M where
  toFun := (⇑)
  map_add' x y := by
    ext
    simp
  map_smul' x y := by
    ext
    simp
#align finsupp.lcoe_fun Finsupp.lcoeFun

section LSubtypeDomain

variable (s : Set α)

/-- Interpret `Finsupp.subtypeDomain s` as a linear map. -/
def lsubtypeDomain : (α →₀ M) →ₗ[R] s →₀ M
    where
  toFun := subtypeDomain fun x => x ∈ s
  map_add' _ _ := subtypeDomain_add
  map_smul' _ _ := ext fun _ => rfl
#align finsupp.lsubtype_domain Finsupp.lsubtypeDomain

theorem lsubtypeDomain_apply (f : α →₀ M) :
    (lsubtypeDomain s : (α →₀ M) →ₗ[R] s →₀ M) f = subtypeDomain (fun x => x ∈ s) f :=
  rfl
#align finsupp.lsubtype_domain_apply Finsupp.lsubtypeDomain_apply

end LSubtypeDomain

@[simp]
theorem lsingle_apply (a : α) (b : M) : (lsingle a : M →ₗ[R] α →₀ M) b = single a b :=
  rfl
#align finsupp.lsingle_apply Finsupp.lsingle_apply

@[simp]
theorem lapply_apply (a : α) (f : α →₀ M) : (lapply a : (α →₀ M) →ₗ[R] M) f = f a :=
  rfl
#align finsupp.lapply_apply Finsupp.lapply_apply

@[simp]
theorem ker_lsingle (a : α) : ker (lsingle a : M →ₗ[R] α →₀ M) = ⊥ :=
  ker_eq_bot_of_injective (single_injective a)
#align finsupp.ker_lsingle Finsupp.ker_lsingle

theorem lsingle_range_le_ker_lapply (s t : Set α) (h : Disjoint s t) :
    (⨆ a ∈ s, LinearMap.range (lsingle a : M →ₗ[R] α →₀ M)) ≤
      ⨅ a ∈ t, ker (lapply a : (α →₀ M) →ₗ[R] M) := by
  refine' supᵢ_le fun a₁ => supᵢ_le fun h₁ => range_le_iff_comap.2 _
  simp only [(ker_comp _ _).symm, eq_top_iff, SetLike.le_def, mem_ker, comap_infᵢ, mem_infᵢ]
  intro b _ a₂ h₂
  have : a₁ ≠ a₂ := fun eq => h.le_bot ⟨h₁, eq.symm ▸ h₂⟩
  exact single_eq_of_ne this
#align finsupp.lsingle_range_le_ker_lapply Finsupp.lsingle_range_le_ker_lapply

theorem infᵢ_ker_lapply_le_bot : (⨅ a, ker (lapply a : (α →₀ M) →ₗ[R] M)) ≤ ⊥ := by
  simp only [SetLike.le_def, mem_infᵢ, mem_ker, mem_bot, lapply_apply]
  exact fun a h => Finsupp.ext h
#align finsupp.infi_ker_lapply_le_bot Finsupp.infᵢ_ker_lapply_le_bot

theorem supᵢ_lsingle_range : (⨆ a, LinearMap.range (lsingle a : M →ₗ[R] α →₀ M)) = ⊤ := by
  refine' eq_top_iff.2 <| SetLike.le_def.2 fun f _ => _
  rw [← sum_single f]
  exact sum_mem fun a _ => Submodule.mem_supᵢ_of_mem a ⟨_, rfl⟩
#align finsupp.supr_lsingle_range Finsupp.supᵢ_lsingle_range

theorem disjoint_lsingle_lsingle (s t : Set α) (hs : Disjoint s t) :
    Disjoint (⨆ a ∈ s, LinearMap.range (lsingle a : M →ₗ[R] α →₀ M))
      (⨆ a ∈ t, LinearMap.range (lsingle a : M →ₗ[R] α →₀ M)) := by
  -- Porting note: 2 placeholders are added to prevent timeout.
  refine'
    (Disjoint.mono
      (lsingle_range_le_ker_lapply s (sᶜ) _)
      (lsingle_range_le_ker_lapply t (tᶜ) _))
      _
  · apply disjoint_compl_right
  · apply disjoint_compl_right
  rw [disjoint_iff_inf_le]
  refine' le_trans (le_infᵢ fun i => _) infᵢ_ker_lapply_le_bot
  classical
    by_cases his : i ∈ s
    · by_cases hit : i ∈ t
      · exact (hs.le_bot ⟨his, hit⟩).elim
      exact inf_le_of_right_le (infᵢ_le_of_le i <| infᵢ_le _ hit)
    exact inf_le_of_left_le (infᵢ_le_of_le i <| infᵢ_le _ his)
#align finsupp.disjoint_lsingle_lsingle Finsupp.disjoint_lsingle_lsingle

theorem span_single_image (s : Set M) (a : α) :
    Submodule.span R (single a '' s) = (Submodule.span R s).map (lsingle a : M →ₗ[R] α →₀ M) := by
  rw [← span_image]; rfl
#align finsupp.span_single_image Finsupp.span_single_image

variable (M R)

/-- `Finsupp.supported M R s` is the `R`-submodule of all `p : α →₀ M` such that `p.support ⊆ s`. -/
def supported (s : Set α) : Submodule R (α →₀ M) := by
  refine' ⟨⟨⟨{ p | ↑p.support ⊆ s }, _⟩, _⟩, _⟩
  · intro p q hp hq
    refine' Subset.trans (Subset.trans (Finset.coe_subset.2 support_add) _) (union_subset hp hq)
    rw [Finset.coe_union]
  · simp only [subset_def, Finset.mem_coe, Set.mem_setOf_eq, mem_support_iff, zero_apply]
    intro h ha
    exact (ha rfl).elim
  · intro a p hp
    refine' Subset.trans (Finset.coe_subset.2 support_smul) hp
#align finsupp.supported Finsupp.supported

variable {M}

theorem mem_supported {s : Set α} (p : α →₀ M) : p ∈ supported M R s ↔ ↑p.support ⊆ s :=
  Iff.rfl
#align finsupp.mem_supported Finsupp.mem_supported

theorem mem_supported' {s : Set α} (p : α →₀ M) :
    p ∈ supported M R s ↔ ∀ (x) (_ : x ∉ s), p x = 0 := by
  haveI := Classical.decPred fun x : α => x ∈ s; simp [mem_supported, Set.subset_def, not_imp_comm]
#align finsupp.mem_supported' Finsupp.mem_supported'

theorem mem_supported_support (p : α →₀ M) : p ∈ Finsupp.supported M R (p.support : Set α) := by
  rw [Finsupp.mem_supported]
#align finsupp.mem_supported_support Finsupp.mem_supported_support

theorem single_mem_supported {s : Set α} {a : α} (b : M) (h : a ∈ s) :
    single a b ∈ supported M R s :=
  Set.Subset.trans support_single_subset (Finset.singleton_subset_set_iff.2 h)
#align finsupp.single_mem_supported Finsupp.single_mem_supported

theorem supported_eq_span_single (s : Set α) :
    supported R R s = span R ((fun i => single i 1) '' s) := by
  refine' (span_eq_of_le _ _ (SetLike.le_def.2 fun l hl => _)).symm
  · rintro _ ⟨_, hp, rfl⟩
    exact single_mem_supported R 1 hp
  · rw [← l.sum_single]
    refine' sum_mem fun i il => _
  -- Porting note: Needed to help this convert quite a bit replacing underscores
    convert smul_mem (M := α →₀ R) (x := single i 1) (span R ((fun i => single i 1) '' s)) (l i) ?_
    · simp [span]
    · apply subset_span
      apply Set.mem_image_of_mem _ (hl il)
#align finsupp.supported_eq_span_single Finsupp.supported_eq_span_single

variable (M)

/-- Interpret `Finsupp.filter s` as a linear map from `α →₀ M` to `supported M R s`. -/
def restrictDom (s : Set α) : (α →₀ M) →ₗ[R] supported M R s :=
  LinearMap.codRestrict _
    { toFun := filter (· ∈ s)
      map_add' := fun _ _ => filter_add
      map_smul' := fun _ _ => filter_smul } fun l =>
    (mem_supported' _ _).2 fun _ => filter_apply_neg (· ∈ s) l
#align finsupp.restrict_dom Finsupp.restrictDom

variable {M R}

section

@[simp]
theorem restrictDom_apply (s : Set α) (l : α →₀ M) :
    ((restrictDom M R s : (α →₀ M) →ₗ[R] supported M R s) l : α →₀ M) = Finsupp.filter (· ∈ s) l :=
  rfl
#align finsupp.restrict_dom_apply Finsupp.restrictDom_apply

end

theorem restrictDom_comp_subtype (s : Set α) :
    (restrictDom M R s).comp (Submodule.subtype _) = LinearMap.id := by
  ext (l a)
  by_cases h : a ∈ s <;> simp [h]
  exact ((mem_supported' R l.1).1 l.2 a h).symm
#align finsupp.restrict_dom_comp_subtype Finsupp.restrictDom_comp_subtype

theorem range_restrictDom (s : Set α) : LinearMap.range (restrictDom M R s) = ⊤ :=
  range_eq_top.2 <|
    Function.RightInverse.surjective <| LinearMap.congr_fun (restrictDom_comp_subtype s)
#align finsupp.range_restrict_dom Finsupp.range_restrictDom

theorem supported_mono {s t : Set α} (st : s ⊆ t) : supported M R s ≤ supported M R t := fun _ h =>
  Set.Subset.trans h st
#align finsupp.supported_mono Finsupp.supported_mono

@[simp]
theorem supported_empty : supported M R (∅ : Set α) = ⊥ :=
  eq_bot_iff.2 fun l h => (Submodule.mem_bot R).2 <| by ext; simp_all [mem_supported']
#align finsupp.supported_empty Finsupp.supported_empty

@[simp]
theorem supported_univ : supported M R (Set.univ : Set α) = ⊤ :=
  eq_top_iff.2 fun _ _ => Set.subset_univ _
#align finsupp.supported_univ Finsupp.supported_univ

theorem supported_unionᵢ {δ : Type _} (s : δ → Set α) :
    supported M R (⋃ i, s i) = ⨆ i, supported M R (s i) := by
  refine' le_antisymm _ (supᵢ_le fun i => supported_mono <| Set.subset_unionᵢ _ _)
  haveI := Classical.decPred fun x => x ∈ ⋃ i, s i
  suffices
    LinearMap.range ((Submodule.subtype _).comp (restrictDom M R (⋃ i, s i))) ≤
      ⨆ i, supported M R (s i) by
    rwa [LinearMap.range_comp, range_restrictDom, map_top, range_subtype] at this
  rw [range_le_iff_comap, eq_top_iff]
  rintro l ⟨⟩
  -- Porting note: Was ported as `induction l using Finsupp.induction`
  refine Finsupp.induction l ?_ ?_
  · exact zero_mem _
  · refine' fun x a l _ _ => add_mem _
    by_cases h : ∃ i, x ∈ s i <;> simp [h]
    · cases' h with i hi
      exact le_supᵢ (fun i => supported M R (s i)) i (single_mem_supported R _ hi)
#align finsupp.supported_Union Finsupp.supported_unionᵢ

theorem supported_union (s t : Set α) : supported M R (s ∪ t) = supported M R s ⊔ supported M R t :=
  by erw [Set.union_eq_unionᵢ, supported_unionᵢ, supᵢ_bool_eq]; rfl
#align finsupp.supported_union Finsupp.supported_union

theorem supported_interᵢ {ι : Type _} (s : ι → Set α) :
    supported M R (⋂ i, s i) = ⨅ i, supported M R (s i) :=
  Submodule.ext fun x => by simp [mem_supported, subset_interᵢ_iff]
#align finsupp.supported_Inter Finsupp.supported_interᵢ

theorem supported_inter (s t : Set α) : supported M R (s ∩ t) = supported M R s ⊓ supported M R t :=
  by rw [Set.inter_eq_interᵢ, supported_interᵢ, infᵢ_bool_eq]; rfl
#align finsupp.supported_inter Finsupp.supported_inter

theorem disjoint_supported_supported {s t : Set α} (h : Disjoint s t) :
    Disjoint (supported M R s) (supported M R t) :=
  disjoint_iff.2 <| by rw [← supported_inter, disjoint_iff_inter_eq_empty.1 h, supported_empty]
#align finsupp.disjoint_supported_supported Finsupp.disjoint_supported_supported

theorem disjoint_supported_supported_iff [Nontrivial M] {s t : Set α} :
    Disjoint (supported M R s) (supported M R t) ↔ Disjoint s t := by
  refine' ⟨fun h => Set.disjoint_left.mpr fun x hx1 hx2 => _, disjoint_supported_supported⟩
  rcases exists_ne (0 : M) with ⟨y, hy⟩
  have := h.le_bot ⟨single_mem_supported R y hx1, single_mem_supported R y hx2⟩
  rw [mem_bot, single_eq_zero] at this
  exact hy this
#align finsupp.disjoint_supported_supported_iff Finsupp.disjoint_supported_supported_iff

/-- Interpret `Finsupp.restrictSupportEquiv` as a linear equivalence between
`supported M R s` and `s →₀ M`. -/
def supportedEquivFinsupp (s : Set α) : supported M R s ≃ₗ[R] s →₀ M := by
  let F : supported M R s ≃ (s →₀ M) := restrictSupportEquiv s M
  refine' F.toLinearEquiv _
  have :
    (F : supported M R s → ↥s →₀ M) =
      (lsubtypeDomain s : (α →₀ M) →ₗ[R] s →₀ M).comp (Submodule.subtype (supported M R s)) :=
    rfl
  rw [this]
  exact LinearMap.isLinear _
#align finsupp.supported_equiv_finsupp Finsupp.supportedEquivFinsupp

section LSum

variable (S)
variable [Module S N] [SMulCommClass R S N]

/-- Lift a family of linear maps `M →ₗ[R] N` indexed by `x : α` to a linear map from `α →₀ M` to
`N` using `Finsupp.sum`. This is an upgraded version of `Finsupp.liftAddHom`.

See note [bundled maps over different rings] for why separate `R` and `S` semirings are used.
-/
def lsum : (α → M →ₗ[R] N) ≃ₗ[S] (α →₀ M) →ₗ[R] N where
  toFun F :=
    { toFun := fun d => d.sum fun i => F i
      map_add' := (liftAddHom (α := α) (M := M) (N := N) fun x => (F x).toAddMonoidHom).map_add
      map_smul' := fun c f => by simp [sum_smul_index', smul_sum] }
  invFun F x := F.comp (lsingle x)
  left_inv F := by
    ext x y
    simp
  right_inv F := by
    ext x y
    simp
  map_add' F G := by
    ext x y
    simp
  map_smul' F G := by
    ext x y
    simp
#align finsupp.lsum Finsupp.lsum

@[simp]
theorem coe_lsum (f : α → M →ₗ[R] N) : (lsum S f : (α →₀ M) → N) = fun d => d.sum fun i => f i :=
  rfl
#align finsupp.coe_lsum Finsupp.coe_lsum

theorem lsum_apply (f : α → M →ₗ[R] N) (l : α →₀ M) : Finsupp.lsum S f l = l.sum fun b => f b :=
  rfl
#align finsupp.lsum_apply Finsupp.lsum_apply

theorem lsum_single (f : α → M →ₗ[R] N) (i : α) (m : M) :
    Finsupp.lsum S f (Finsupp.single i m) = f i m :=
  Finsupp.sum_single_index (f i).map_zero
#align finsupp.lsum_single Finsupp.lsum_single

theorem lsum_symm_apply (f : (α →₀ M) →ₗ[R] N) (x : α) : (lsum S).symm f x = f.comp (lsingle x) :=
  rfl
#align finsupp.lsum_symm_apply Finsupp.lsum_symm_apply

end LSum

section

variable (M) (R) (X : Type _) (S)
variable [Module S M] [SMulCommClass R S M]

/-- A slight rearrangement from `lsum` gives us
the bijection underlying the free-forgetful adjunction for R-modules.
-/
noncomputable def lift : (X → M) ≃+ ((X →₀ R) →ₗ[R] M) :=
  (AddEquiv.arrowCongr (Equiv.refl X) (ringLmapEquivSelf R ℕ M).toAddEquiv.symm).trans
    (lsum _ : _ ≃ₗ[ℕ] _).toAddEquiv
#align finsupp.lift Finsupp.lift

@[simp]
theorem lift_symm_apply (f) (x) : ((lift M R X).symm f) x = f (single x 1) :=
  rfl
#align finsupp.lift_symm_apply Finsupp.lift_symm_apply

@[simp]
theorem lift_apply (f) (g) : ((lift M R X) f) g = g.sum fun x r => r • f x :=
  rfl
#align finsupp.lift_apply Finsupp.lift_apply

/-- Given compatible `S` and `R`-module structures on `M` and a type `X`, the set of functions
`X → M` is `S`-linearly equivalent to the `R`-linear maps from the free `R`-module
on `X` to `M`. -/
noncomputable def llift : (X → M) ≃ₗ[S] (X →₀ R) →ₗ[R] M :=
  { lift M R X with
    map_smul' := by
      intros
      dsimp
      ext
      simp only [coe_comp, Function.comp_apply, lsingle_apply, lift_apply, Pi.smul_apply,
        sum_single_index, zero_smul, one_smul, LinearMap.smul_apply] }
#align finsupp.llift Finsupp.llift

@[simp]
theorem llift_apply (f : X → M) (x : X →₀ R) : llift M R S X f x = lift M R X f x :=
  rfl
#align finsupp.llift_apply Finsupp.llift_apply

@[simp]
theorem llift_symm_apply (f : (X →₀ R) →ₗ[R] M) (x : X) :
    (llift M R S X).symm f x = f (single x 1) :=
  rfl
#align finsupp.llift_symm_apply Finsupp.llift_symm_apply

end

section LMapDomain

variable {α' : Type _} {α'' : Type _} (M R)

/-- Interpret `Finsupp.mapDomain` as a linear map. -/
def lmapDomain (f : α → α') : (α →₀ M) →ₗ[R] α' →₀ M
    where
  toFun := mapDomain f
  map_add' _ _ := mapDomain_add
  map_smul' := mapDomain_smul
#align finsupp.lmap_domain Finsupp.lmapDomain

@[simp]
theorem lmapDomain_apply (f : α → α') (l : α →₀ M) :
    (lmapDomain M R f : (α →₀ M) →ₗ[R] α' →₀ M) l = mapDomain f l :=
  rfl
#align finsupp.lmap_domain_apply Finsupp.lmapDomain_apply

@[simp]
theorem lmapDomain_id : (lmapDomain M R _root_.id : (α →₀ M) →ₗ[R] α →₀ M) = LinearMap.id :=
  LinearMap.ext fun _ => mapDomain_id
#align finsupp.lmap_domain_id Finsupp.lmapDomain_id

theorem lmapDomain_comp (f : α → α') (g : α' → α'') :
    lmapDomain M R (g ∘ f) = (lmapDomain M R g).comp (lmapDomain M R f) :=
  LinearMap.ext fun _ => mapDomain_comp
#align finsupp.lmap_domain_comp Finsupp.lmapDomain_comp

theorem supported_comap_lmapDomain (f : α → α') (s : Set α') :
    supported M R (f ⁻¹' s) ≤ (supported M R s).comap (lmapDomain M R f) :=
  fun l (hl : (l.support : Set α) ⊆ f ⁻¹' s) =>
  show ↑(mapDomain f l).support ⊆ s by
    rw [← Set.image_subset_iff, ← Finset.coe_image] at hl
    exact Set.Subset.trans mapDomain_support hl
#align finsupp.supported_comap_lmap_domain Finsupp.supported_comap_lmapDomain

theorem lmapDomain_supported [Nonempty α] (f : α → α') (s : Set α) :
    (supported M R s).map (lmapDomain M R f) = supported M R (f '' s) := by
  inhabit α
  refine
    le_antisymm
      (map_le_iff_le_comap.2 <|
        le_trans (supported_mono <| Set.subset_preimage_image _ _)
          (supported_comap_lmapDomain M R _ _))
      ?_
  intro l hl
  refine' ⟨(lmapDomain M R (Function.invFunOn f s) : (α' →₀ M) →ₗ[R] α →₀ M) l, fun x hx => _, _⟩
  · rcases Finset.mem_image.1 (mapDomain_support hx) with ⟨c, hc, rfl⟩
    exact Function.invFunOn_mem (by simpa using hl hc)
  · rw [← LinearMap.comp_apply, ← lmapDomain_comp]
    refine' (mapDomain_congr fun c hc => _).trans mapDomain_id
    exact Function.invFunOn_eq (by simpa using hl hc)
#align finsupp.lmap_domain_supported Finsupp.lmapDomain_supported

theorem lmapDomain_disjoint_ker (f : α → α') {s : Set α}
    (H : ∀ (a) (_ : a ∈ s) (b) (_ : b ∈ s), f a = f b → a = b) :
    Disjoint (supported M R s) (ker (lmapDomain M R f)) := by
  rw [disjoint_iff_inf_le]
  rintro l ⟨h₁, h₂⟩
  rw [SetLike.mem_coe, mem_ker, lmapDomain_apply, mapDomain] at h₂
  simp; ext x
  haveI := Classical.decPred fun x => x ∈ s
  by_cases xs : x ∈ s
  · have : Finsupp.sum l (fun a => Finsupp.single (f a)) (f x) = 0 :=
      by
      rw [h₂]
      rfl
    rw [Finsupp.sum_apply, Finsupp.sum, Finset.sum_eq_single x, single_eq_same] at this
    · simpa
    · intro y hy xy
      simp [mt (H _ (h₁ hy) _ xs) xy]
    · simp (config := { contextual := true })
  · by_contra h
    exact xs (h₁ <| Finsupp.mem_support_iff.2 h)
#align finsupp.lmap_domain_disjoint_ker Finsupp.lmapDomain_disjoint_ker

end LMapDomain

section LComapDomain

variable {β : Type _}

/-- Given `f : α → β` and a proof `hf` that `f` is injective, `lcomapDomain f hf` is the linear map
sending  `l : β →₀ M` to the finitely supported function from `α` to `M` given by composing
`l` with `f`.

This is the linear version of `Finsupp.comapDomain`. -/
def lcomapDomain (f : α → β) (hf : Function.Injective f) : (β →₀ M) →ₗ[R] α →₀ M
    where
  toFun l := Finsupp.comapDomain f l (hf.injOn _)
  map_add' x y := by ext; simp
  map_smul' c x := by ext; simp
#align finsupp.lcomap_domain Finsupp.lcomapDomain

end LComapDomain

section Total

variable (α) {α' : Type _} (M) {M' : Type _} (R) [Semiring R] [AddCommMonoid M'] [AddCommMonoid M]
  [Module R M'] [Module R M] (v : α → M) {v' : α' → M'}

/-- Interprets (l : α →₀ R) as linear combination of the elements in the family (v : α → M) and
    evaluates this linear combination. -/
protected def total : (α →₀ R) →ₗ[R] M :=
  Finsupp.lsum ℕ fun i => LinearMap.id.smulRight (v i)
#align finsupp.total Finsupp.total

variable {α M v}

theorem total_apply (l : α →₀ R) : Finsupp.total α M R v l = l.sum fun i a => a • v i :=
  rfl
#align finsupp.total_apply Finsupp.total_apply

theorem total_apply_of_mem_supported {l : α →₀ R} {s : Finset α}
    (hs : l ∈ supported R R (↑s : Set α)) : Finsupp.total α M R v l = s.sum fun i => l i • v i :=
  Finset.sum_subset hs fun x _ hxg =>
    show l x • v x = 0 by rw [not_mem_support_iff.1 hxg, zero_smul]
#align finsupp.total_apply_of_mem_supported Finsupp.total_apply_of_mem_supported

@[simp]
theorem total_single (c : R) (a : α) : Finsupp.total α M R v (single a c) = c • v a := by
  simp [total_apply, sum_single_index]
#align finsupp.total_single Finsupp.total_single

theorem total_zero_apply (x : α →₀ R) : (Finsupp.total α M R 0) x = 0 := by
  simp [Finsupp.total_apply]
#align finsupp.total_zero_apply Finsupp.total_zero_apply

variable (α M)

@[simp]
theorem total_zero : Finsupp.total α M R 0 = 0 :=
  LinearMap.ext (total_zero_apply R)
#align finsupp.total_zero Finsupp.total_zero

variable {α M}

theorem apply_total (f : M →ₗ[R] M') (v) (l : α →₀ R) :
    f (Finsupp.total α M R v l) = Finsupp.total α M' R (f ∘ v) l := by
  apply Finsupp.induction_linear l <;> simp (config := { contextual := true })
#align finsupp.apply_total Finsupp.apply_total

theorem total_unique [Unique α] (l : α →₀ R) (v) :
    Finsupp.total α M R v l = l default • v default := by rw [← total_single, ← unique_single l]
#align finsupp.total_unique Finsupp.total_unique

theorem total_surjective (h : Function.Surjective v) :
    Function.Surjective (Finsupp.total α M R v) := by
  intro x
  obtain ⟨y, hy⟩ := h x
  exact ⟨Finsupp.single y 1, by simp [hy]⟩
#align finsupp.total_surjective Finsupp.total_surjective

theorem total_range (h : Function.Surjective v) : LinearMap.range (Finsupp.total α M R v) = ⊤ :=
  range_eq_top.2 <| total_surjective R h
#align finsupp.total_range Finsupp.total_range

/-- Any module is a quotient of a free module. This is stated as surjectivity of
`Finsupp.total M M R id : (M →₀ R) →ₗ[R] M`. -/
theorem total_id_surjective (M) [AddCommMonoid M] [Module R M] :
    Function.Surjective (Finsupp.total M M R _root_.id) :=
  total_surjective R Function.surjective_id
#align finsupp.total_id_surjective Finsupp.total_id_surjective

theorem range_total : LinearMap.range (Finsupp.total α M R v) = span R (range v) := by
  ext x
  constructor
  · intro hx
    rw [LinearMap.mem_range] at hx
    rcases hx with ⟨l, hl⟩
    rw [← hl]
    rw [Finsupp.total_apply]
    exact sum_mem fun i _ => Submodule.smul_mem _ _ (subset_span (mem_range_self i))
  · apply span_le.2
    intro x hx
    rcases hx with ⟨i, hi⟩
    rw [SetLike.mem_coe, LinearMap.mem_range]
    use Finsupp.single i 1
    simp [hi]
#align finsupp.range_total Finsupp.range_total

theorem lmapDomain_total (f : α → α') (g : M →ₗ[R] M') (h : ∀ i, g (v i) = v' (f i)) :
    (Finsupp.total α' M' R v').comp (lmapDomain R R f) = g.comp (Finsupp.total α M R v) := by
  ext l
  simp [total_apply, Finsupp.sum_mapDomain_index, add_smul, h]
#align finsupp.lmap_domain_total Finsupp.lmapDomain_total

theorem total_comp_lmapDomain (f : α → α') :
    (Finsupp.total α' M' R v').comp (Finsupp.lmapDomain R R f) = Finsupp.total α M' R (v' ∘ f) := by
  ext
  simp
#align finsupp.total_comp_lmap_domain Finsupp.total_comp_lmapDomain

@[simp]
theorem total_embDomain (f : α ↪ α') (l : α →₀ R) :
    (Finsupp.total α' M' R v') (embDomain f l) = (Finsupp.total α M' R (v' ∘ f)) l := by
  simp [total_apply, Finsupp.sum, support_embDomain, embDomain_apply]
#align finsupp.total_emb_domain Finsupp.total_embDomain

@[simp]
theorem total_mapDomain (f : α → α') (l : α →₀ R) :
    (Finsupp.total α' M' R v') (mapDomain f l) = (Finsupp.total α M' R (v' ∘ f)) l :=
  LinearMap.congr_fun (total_comp_lmapDomain _ _) l
#align finsupp.total_map_domain Finsupp.total_mapDomain

@[simp]
theorem total_equivMapDomain (f : α ≃ α') (l : α →₀ R) :
    (Finsupp.total α' M' R v') (equivMapDomain f l) = (Finsupp.total α M' R (v' ∘ f)) l := by
  rw [equivMapDomain_eq_mapDomain, total_mapDomain]
#align finsupp.total_equiv_map_domain Finsupp.total_equivMapDomain

/-- A version of `Finsupp.range_total` which is useful for going in the other direction -/
theorem span_eq_range_total (s : Set M) : span R s = LinearMap.range (Finsupp.total s M R (↑)) := by
  rw [range_total, Subtype.range_coe_subtype, Set.setOf_mem_eq]
#align finsupp.span_eq_range_total Finsupp.span_eq_range_total

theorem mem_span_iff_total (s : Set M) (x : M) :
    x ∈ span R s ↔ ∃ l : s →₀ R, Finsupp.total s M R (↑) l = x :=
  (SetLike.ext_iff.1 <| span_eq_range_total _ _) x
#align finsupp.mem_span_iff_total Finsupp.mem_span_iff_total

variable {R}

theorem mem_span_range_iff_exists_finsupp {v : α → M} {x : M} :
    x ∈ span R (range v) ↔ ∃ c : α →₀ R, (c.sum fun i a => a • v i) = x := by
  simp only [← Finsupp.range_total, LinearMap.mem_range, Finsupp.total_apply]
#align finsupp.mem_span_range_iff_exists_finsupp Finsupp.mem_span_range_iff_exists_finsupp

variable (R)

theorem span_image_eq_map_total (s : Set α) :
    span R (v '' s) = Submodule.map (Finsupp.total α M R v) (supported R R s) := by
  apply span_eq_of_le
  · intro x hx
    rw [Set.mem_image] at hx
    apply Exists.elim hx
    intro i hi
    exact ⟨_, Finsupp.single_mem_supported R 1 hi.1, by simp [hi.2]⟩
  · refine' map_le_iff_le_comap.2 fun z hz => _
    have : ∀ i, z i • v i ∈ span R (v '' s) := by
      intro c
      haveI := Classical.decPred fun x => x ∈ s
      by_cases h : c ∈ s
      · exact smul_mem _ _ (subset_span (Set.mem_image_of_mem _ h))
      · simp [(Finsupp.mem_supported' R _).1 hz _ h]
    -- Porting note: `rw` is required to infer metavariables in `sum_mem`.
    rw [mem_comap, total_apply]
    refine' sum_mem _
    simp [this]
#align finsupp.span_image_eq_map_total Finsupp.span_image_eq_map_total

theorem mem_span_image_iff_total {s : Set α} {x : M} :
    x ∈ span R (v '' s) ↔ ∃ l ∈ supported R R s, Finsupp.total α M R v l = x := by
  rw [span_image_eq_map_total]
  simp
#align finsupp.mem_span_image_iff_total Finsupp.mem_span_image_iff_total

theorem total_option (v : Option α → M) (f : Option α →₀ R) :
    Finsupp.total (Option α) M R v f =
      f none • v none + Finsupp.total α M R (v ∘ Option.some) f.some :=
  by rw [total_apply, sum_option_index_smul, total_apply]; simp
#align finsupp.total_option Finsupp.total_option

theorem total_total {α β : Type _} (A : α → M) (B : β → α →₀ R) (f : β →₀ R) :
    Finsupp.total α M R A (Finsupp.total β (α →₀ R) R B f) =
      Finsupp.total β M R (fun b => Finsupp.total α M R A (B b)) f := by
  simp only [total_apply]
  apply induction_linear f
  · simp only [sum_zero_index]
  · intro f₁ f₂ h₁ h₂
    simp [sum_add_index, h₁, h₂, add_smul]
  · simp [sum_single_index, sum_smul_index, smul_sum, mul_smul]
#align finsupp.total_total Finsupp.total_total

@[simp]
theorem total_fin_zero (f : Fin 0 → M) : Finsupp.total (Fin 0) M R f = 0 := by
  ext i
  apply finZeroElim i
#align finsupp.total_fin_zero Finsupp.total_fin_zero

variable (α) (M) (v)

/-- `Finsupp.totalOn M v s` interprets `p : α →₀ R` as a linear combination of a
subset of the vectors in `v`, mapping it to the span of those vectors.

The subset is indicated by a set `s : set α` of indices.
-/
protected def totalOn (s : Set α) : supported R R s →ₗ[R] span R (v '' s) :=
  LinearMap.codRestrict _ ((Finsupp.total _ _ _ v).comp (Submodule.subtype (supported R R s)))
    fun ⟨l, hl⟩ => (mem_span_image_iff_total _).2 ⟨l, hl, rfl⟩
#align finsupp.total_on Finsupp.totalOn

variable {α} {M} {v}

theorem totalOn_range (s : Set α) : LinearMap.range (Finsupp.totalOn α M R v s) = ⊤ := by
  rw [Finsupp.totalOn, LinearMap.range_eq_map, LinearMap.map_codRestrict, ←
    LinearMap.range_le_iff_comap, range_subtype, map_top, LinearMap.range_comp, range_subtype]
  exact (span_image_eq_map_total _ _).le
#align finsupp.total_on_range Finsupp.totalOn_range

theorem total_comp (f : α' → α) :
    Finsupp.total α' M R (v ∘ f) = (Finsupp.total α M R v).comp (lmapDomain R R f) := by
  ext
  simp [total_apply]
#align finsupp.total_comp Finsupp.total_comp

theorem total_comapDomain (f : α → α') (l : α' →₀ R) (hf : Set.InjOn f (f ⁻¹' ↑l.support)) :
    Finsupp.total α M R v (Finsupp.comapDomain f l hf) =
      (l.support.preimage f hf).sum fun i => l (f i) • v i :=
  by rw [Finsupp.total_apply]; rfl
#align finsupp.total_comap_domain Finsupp.total_comapDomain

theorem total_onFinset {s : Finset α} {f : α → R} (g : α → M) (hf : ∀ a, f a ≠ 0 → a ∈ s) :
    Finsupp.total α M R g (Finsupp.onFinset s f hf) = Finset.sum s fun x : α => f x • g x := by
  simp only [Finsupp.total_apply, Finsupp.sum, Finsupp.onFinset_apply, Finsupp.support_onFinset]
  rw [Finset.sum_filter_of_ne]
  intro x _ h
  contrapose! h
  simp [h]
#align finsupp.total_on_finset Finsupp.total_onFinset

end Total

/-- An equivalence of domains induces a linear equivalence of finitely supported functions.

This is `Finsupp.domCongr` as a `LinearEquiv`.
See also `LinearMap.funCongrLeft` for the case of arbitrary functions. -/
protected def domLCongr {α₁ α₂ : Type _} (e : α₁ ≃ α₂) : (α₁ →₀ M) ≃ₗ[R] α₂ →₀ M :=
  (Finsupp.domCongr e : (α₁ →₀ M) ≃+ (α₂ →₀ M)).toLinearEquiv <| by
    simpa only [equivMapDomain_eq_mapDomain, domCongr_apply] using (lmapDomain M R e).map_smul
#align finsupp.dom_lcongr Finsupp.domLCongr

@[simp]
theorem domLCongr_apply {α₁ : Type _} {α₂ : Type _} (e : α₁ ≃ α₂) (v : α₁ →₀ M) :
    (Finsupp.domLCongr e : _ ≃ₗ[R] _) v = Finsupp.domCongr e v :=
  rfl
#align finsupp.dom_lcongr_apply Finsupp.domLCongr_apply

@[simp]
theorem domLCongr_refl : Finsupp.domLCongr (Equiv.refl α) = LinearEquiv.refl R (α →₀ M) :=
  LinearEquiv.ext fun _ => equivMapDomain_refl _
#align finsupp.dom_lcongr_refl Finsupp.domLCongr_refl

theorem domLCongr_trans {α₁ α₂ α₃ : Type _} (f : α₁ ≃ α₂) (f₂ : α₂ ≃ α₃) :
    (Finsupp.domLCongr f).trans (Finsupp.domLCongr f₂) =
      (Finsupp.domLCongr (f.trans f₂) : (_ →₀ M) ≃ₗ[R] _) :=
  LinearEquiv.ext fun _ => (equivMapDomain_trans _ _ _).symm
#align finsupp.dom_lcongr_trans Finsupp.domLCongr_trans

@[simp]
theorem domLCongr_symm {α₁ α₂ : Type _} (f : α₁ ≃ α₂) :
    ((Finsupp.domLCongr f).symm : (_ →₀ M) ≃ₗ[R] _) = Finsupp.domLCongr f.symm :=
  LinearEquiv.ext fun _ => rfl
#align finsupp.dom_lcongr_symm Finsupp.domLCongr_symm

-- @[simp] -- Porting note: simp can prove this
theorem domLCongr_single {α₁ : Type _} {α₂ : Type _} (e : α₁ ≃ α₂) (i : α₁) (m : M) :
    (Finsupp.domLCongr e : _ ≃ₗ[R] _) (Finsupp.single i m) = Finsupp.single (e i) m := by
  simp
#align finsupp.dom_lcongr_single Finsupp.domLCongr_single

/-- An equivalence of sets induces a linear equivalence of `Finsupp`s supported on those sets. -/
noncomputable def congr {α' : Type _} (s : Set α) (t : Set α') (e : s ≃ t) :
    supported M R s ≃ₗ[R] supported M R t := by
  haveI := Classical.decPred fun x => x ∈ s
  haveI := Classical.decPred fun x => x ∈ t
  exact Finsupp.supportedEquivFinsupp s ≪≫ₗ
    (Finsupp.domLCongr e ≪≫ₗ (Finsupp.supportedEquivFinsupp t).symm)
#align finsupp.congr Finsupp.congr

/-- `Finsupp.mapRange` as a `LinearMap`. -/
def mapRange.linearMap (f : M →ₗ[R] N) : (α →₀ M) →ₗ[R] α →₀ N :=
  { mapRange.addMonoidHom f.toAddMonoidHom with
    toFun := (mapRange f f.map_zero : (α →₀ M) → α →₀ N)
    -- Porting note: `hf` should be specified.
    map_smul' := fun c v => mapRange_smul (hf := f.map_zero) c v (f.map_smul c) }
#align finsupp.map_range.linear_map Finsupp.mapRange.linearMap

-- Porting note: This was generated by `simps!`.
@[simp]

@[simp]
theorem mapRange.linearMap_id :
    mapRange.linearMap LinearMap.id = (LinearMap.id : (α →₀ M) →ₗ[R] _) :=
  LinearMap.ext mapRange_id
#align finsupp.map_range.linear_map_id Finsupp.mapRange.linearMap_id

theorem mapRange.linearMap_comp (f : N →ₗ[R] P) (f₂ : M →ₗ[R] N) :
    (mapRange.linearMap (f.comp f₂) : (α →₀ _) →ₗ[R] _) =
      (mapRange.linearMap f).comp (mapRange.linearMap f₂) :=
  -- Porting note: Placeholders should be filled.
  LinearMap.ext <| mapRange_comp f f.map_zero f₂ f₂.map_zero (comp f f₂).map_zero
#align finsupp.map_range.linear_map_comp Finsupp.mapRange.linearMap_comp

@[simp]
theorem mapRange.linearMap_toAddMonoidHom (f : M →ₗ[R] N) :
    (mapRange.linearMap f).toAddMonoidHom =
      (mapRange.addMonoidHom f.toAddMonoidHom : (α →₀ M) →+ _) :=
  AddMonoidHom.ext fun _ => rfl
#align finsupp.map_range.linear_map_to_add_monoid_hom Finsupp.mapRange.linearMap_toAddMonoidHom

/-- `Finsupp.mapRange` as a `LinearEquiv`. -/
def mapRange.linearEquiv (e : M ≃ₗ[R] N) : (α →₀ M) ≃ₗ[R] α →₀ N :=
  { mapRange.linearMap e.toLinearMap,
    mapRange.addEquiv e.toAddEquiv with
    toFun := mapRange e e.map_zero
    invFun := mapRange e.symm e.symm.map_zero }
#align finsupp.map_range.linear_equiv Finsupp.mapRange.linearEquiv

-- Porting note: This was generated by `simps`.
@[simp]
theorem mapRange.linearEquiv_apply (e : M ≃ₗ[R] N) (g : α →₀ M) :
    mapRange.linearEquiv e g = mapRange.linearMap e.toLinearMap g := rfl
#align finsupp.map_range.linear_equiv_apply Finsupp.mapRange.linearEquiv_apply

@[simp]
theorem mapRange.linearEquiv_refl :
    mapRange.linearEquiv (LinearEquiv.refl R M) = LinearEquiv.refl R (α →₀ M) :=
  LinearEquiv.ext mapRange_id
#align finsupp.map_range.linear_equiv_refl Finsupp.mapRange.linearEquiv_refl

theorem mapRange.linearEquiv_trans (f : M ≃ₗ[R] N) (f₂ : N ≃ₗ[R] P) :
    (mapRange.linearEquiv (f.trans f₂) : (α →₀ _) ≃ₗ[R] _) =
      (mapRange.linearEquiv f).trans (mapRange.linearEquiv f₂) :=
  -- Porting note: Placeholders should be filled.
  LinearEquiv.ext <| mapRange_comp f₂ f₂.map_zero f f.map_zero (f.trans f₂).map_zero
#align finsupp.map_range.linear_equiv_trans Finsupp.mapRange.linearEquiv_trans

@[simp]
theorem mapRange.linearEquiv_symm (f : M ≃ₗ[R] N) :
    ((mapRange.linearEquiv f).symm : (α →₀ _) ≃ₗ[R] _) = mapRange.linearEquiv f.symm :=
  LinearEquiv.ext fun _x => rfl
#align finsupp.map_range.linear_equiv_symm Finsupp.mapRange.linearEquiv_symm

-- Porting note: This priority should be higher than `LinearEquiv.coe_toAddEquiv`.
@[simp 1500]
theorem mapRange.linearEquiv_toAddEquiv (f : M ≃ₗ[R] N) :
    (mapRange.linearEquiv f).toAddEquiv = (mapRange.addEquiv f.toAddEquiv : (α →₀ M) ≃+ _) :=
  AddEquiv.ext fun _ => rfl
#align finsupp.map_range.linear_equiv_to_add_equiv Finsupp.mapRange.linearEquiv_toAddEquiv

@[simp]
theorem mapRange.linearEquiv_toLinearMap (f : M ≃ₗ[R] N) :
    (mapRange.linearEquiv f).toLinearMap = (mapRange.linearMap f.toLinearMap : (α →₀ M) →ₗ[R] _) :=
  LinearMap.ext fun _ => rfl
#align finsupp.map_range.linear_equiv_to_linear_map Finsupp.mapRange.linearEquiv_toLinearMap

/-- An equivalence of domain and a linear equivalence of codomain induce a linear equivalence of the
corresponding finitely supported functions. -/
def lcongr {ι κ : Sort _} (e₁ : ι ≃ κ) (e₂ : M ≃ₗ[R] N) : (ι →₀ M) ≃ₗ[R] κ →₀ N :=
  (Finsupp.domLCongr e₁).trans (mapRange.linearEquiv e₂)
#align finsupp.lcongr Finsupp.lcongr

@[simp]
theorem lcongr_single {ι κ : Sort _} (e₁ : ι ≃ κ) (e₂ : M ≃ₗ[R] N) (i : ι) (m : M) :
    lcongr e₁ e₂ (Finsupp.single i m) = Finsupp.single (e₁ i) (e₂ m) := by simp [lcongr]
#align finsupp.lcongr_single Finsupp.lcongr_single

@[simp]
theorem lcongr_apply_apply {ι κ : Sort _} (e₁ : ι ≃ κ) (e₂ : M ≃ₗ[R] N) (f : ι →₀ M) (k : κ) :
    lcongr e₁ e₂ f k = e₂ (f (e₁.symm k)) :=
  rfl
#align finsupp.lcongr_apply_apply Finsupp.lcongr_apply_apply

theorem lcongr_symm_single {ι κ : Sort _} (e₁ : ι ≃ κ) (e₂ : M ≃ₗ[R] N) (k : κ) (n : N) :
    (lcongr e₁ e₂).symm (Finsupp.single k n) = Finsupp.single (e₁.symm k) (e₂.symm n) := by
  apply_fun (lcongr e₁ e₂ : (ι →₀ M) → (κ →₀ N)) using (lcongr e₁ e₂).injective
  simp
#align finsupp.lcongr_symm_single Finsupp.lcongr_symm_single

@[simp]
theorem lcongr_symm {ι κ : Sort _} (e₁ : ι ≃ κ) (e₂ : M ≃ₗ[R] N) :
    (lcongr e₁ e₂).symm = lcongr e₁.symm e₂.symm := by
  ext
  rfl
#align finsupp.lcongr_symm Finsupp.lcongr_symm

section Sum

variable (R)

/-- The linear equivalence between `(α ⊕ β) →₀ M` and `(α →₀ M) × (β →₀ M)`.

This is the `LinearEquiv` version of `Finsupp.sumFinsuppEquivProdFinsupp`. -/
@[simps apply symm_apply]
def sumFinsuppLEquivProdFinsupp {α β : Type _} : (Sum α β →₀ M) ≃ₗ[R] (α →₀ M) × (β →₀ M) :=
  { sumFinsuppAddEquivProdFinsupp with
    map_smul' := by
      intros
      ext <;>
        -- Porting note: `add_equiv.to_fun_eq_coe` →
        --               `Equiv.toFun_as_coe` & `AddEquiv.toEquiv_eq_coe` & `AddEquiv.coe_toEquiv`
        simp only [Equiv.toFun_as_coe, AddEquiv.toEquiv_eq_coe, AddEquiv.coe_toEquiv, Prod.smul_fst,
          Prod.smul_snd, smul_apply,
          snd_sumFinsuppAddEquivProdFinsupp, fst_sumFinsuppAddEquivProdFinsupp,
          RingHom.id_apply] }
#align finsupp.sum_finsupp_lequiv_prod_finsupp Finsupp.sumFinsuppLEquivProdFinsupp

theorem fst_sumFinsuppLEquivProdFinsupp {α β : Type _} (f : Sum α β →₀ M) (x : α) :
    (sumFinsuppLEquivProdFinsupp R f).1 x = f (Sum.inl x) :=
  rfl
#align finsupp.fst_sum_finsupp_lequiv_prod_finsupp Finsupp.fst_sumFinsuppLEquivProdFinsupp

theorem snd_sumFinsuppLEquivProdFinsupp {α β : Type _} (f : Sum α β →₀ M) (y : β) :
    (sumFinsuppLEquivProdFinsupp R f).2 y = f (Sum.inr y) :=
  rfl
#align finsupp.snd_sum_finsupp_lequiv_prod_finsupp Finsupp.snd_sumFinsuppLEquivProdFinsupp

theorem sumFinsuppLEquivProdFinsupp_symm_inl {α β : Type _} (fg : (α →₀ M) × (β →₀ M)) (x : α) :
    ((sumFinsuppLEquivProdFinsupp R).symm fg) (Sum.inl x) = fg.1 x :=
  rfl
#align finsupp.sum_finsupp_lequiv_prod_finsupp_symm_inl Finsupp.sumFinsuppLEquivProdFinsupp_symm_inl

theorem sumFinsuppLEquivProdFinsupp_symm_inr {α β : Type _} (fg : (α →₀ M) × (β →₀ M)) (y : β) :
    ((sumFinsuppLEquivProdFinsupp R).symm fg) (Sum.inr y) = fg.2 y :=
  rfl
#align finsupp.sum_finsupp_lequiv_prod_finsupp_symm_inr Finsupp.sumFinsuppLEquivProdFinsupp_symm_inr

end Sum

section Sigma

variable {η : Type _} [Fintype η] {ιs : η → Type _} [Zero α]

variable (R)

/-- On a `Fintype η`, `Finsupp.split` is a linear equivalence between
`(Σ (j : η), ιs j) →₀ M` and `(j : η) → (ιs j →₀ M)`.

This is the `LinearEquiv` version of `Finsupp.sigmaFinsuppAddEquivPiFinsupp`. -/
noncomputable def sigmaFinsuppLEquivPiFinsupp {M : Type _} {ιs : η → Type _} [AddCommMonoid M]
    [Module R M] : ((Σ j, ιs j) →₀ M) ≃ₗ[R] (j : _) → (ιs j →₀ M) :=
  -- Porting note: `ιs` should be specified.
  { sigmaFinsuppAddEquivPiFinsupp (ιs := ιs) with
    map_smul' := fun c f => by
      ext
      simp }
#align finsupp.sigma_finsupp_lequiv_pi_finsupp Finsupp.sigmaFinsuppLEquivPiFinsupp

@[simp]
theorem sigmaFinsuppLEquivPiFinsupp_apply {M : Type _} {ιs : η → Type _} [AddCommMonoid M]
    [Module R M] (f : (Σj, ιs j) →₀ M) (j i) : sigmaFinsuppLEquivPiFinsupp R f j i = f ⟨j, i⟩ :=
  rfl
#align finsupp.sigma_finsupp_lequiv_pi_finsupp_apply Finsupp.sigmaFinsuppLEquivPiFinsupp_apply

@[simp]
theorem sigmaFinsuppLEquivPiFinsupp_symm_apply {M : Type _} {ιs : η → Type _} [AddCommMonoid M]
    [Module R M] (f : (j : _) → (ιs j →₀ M)) (ji) :
    (Finsupp.sigmaFinsuppLEquivPiFinsupp R).symm f ji = f ji.1 ji.2 :=
  rfl
#align finsupp.sigma_finsupp_lequiv_pi_finsupp_symm_apply Finsupp.sigmaFinsuppLEquivPiFinsupp_symm_apply

end Sigma

section Prod

/-- The linear equivalence between `α × β →₀ M` and `α →₀ β →₀ M`.

This is the `LinearEquiv` version of `Finsupp.finsuppProdEquiv`. -/
noncomputable def finsuppProdLEquiv {α β : Type _} (R : Type _) {M : Type _} [Semiring R]
    [AddCommMonoid M] [Module R M] : (α × β →₀ M) ≃ₗ[R] α →₀ β →₀ M :=
  { finsuppProdEquiv with
    map_add' := fun f g => by
      ext
      simp [finsuppProdEquiv, curry_apply]
    map_smul' := fun c f => by
      ext
      simp [finsuppProdEquiv, curry_apply] }
#align finsupp.finsupp_prod_lequiv Finsupp.finsuppProdLEquiv

@[simp]
theorem finsuppProdLEquiv_apply {α β R M : Type _} [Semiring R] [AddCommMonoid M] [Module R M]
    (f : α × β →₀ M) (x y) : finsuppProdLEquiv R f x y = f (x, y) := by
  rw [finsuppProdLEquiv, LinearEquiv.coe_mk, finsuppProdEquiv, Finsupp.curry_apply]
#align finsupp.finsupp_prod_lequiv_apply Finsupp.finsuppProdLEquiv_apply

@[simp]
theorem finsuppProdLEquiv_symm_apply {α β R M : Type _} [Semiring R] [AddCommMonoid M] [Module R M]
    (f : α →₀ β →₀ M) (xy) : (finsuppProdLEquiv R).symm f xy = f xy.1 xy.2 := by
  conv_rhs =>
    rw [← (finsuppProdLEquiv R).apply_symm_apply f, finsuppProdLEquiv_apply, Prod.mk.eta]
#align finsupp.finsupp_prod_lequiv_symm_apply Finsupp.finsuppProdLEquiv_symm_apply

end Prod

end Finsupp

section Fintype

variable {α M : Type _} (R : Type _) [Fintype α] [Semiring R] [AddCommMonoid M] [Module R M]

variable (S : Type _) [Semiring S] [Module S M] [SMulCommClass R S M]

variable (v : α → M)

/-- `Fintype.total R S v f` is the linear combination of vectors in `v` with weights in `f`.
This variant of `Finsupp.total` is defined on fintype indexed vectors.

This map is linear in `v` if `R` is commutative, and always linear in `f`.
See note [bundled maps over different rings] for why separate `R` and `S` semirings are used.
-/
protected def Fintype.total : (α → M) →ₗ[S] (α → R) →ₗ[R] M where
  toFun v :=
    { toFun := fun f => ∑ i, f i • v i
      map_add' := fun f g => by
        simp_rw [← Finset.sum_add_distrib, ← add_smul]
        rfl
      map_smul' := fun r f => by
        simp_rw [Finset.smul_sum, smul_smul]
        rfl }
  map_add' u v := by
    ext
    simp [Finset.sum_add_distrib, Pi.add_apply, smul_add]
  map_smul' r v := by
    ext g
    -- Porting note: `smul_comm _ r` → `fun x => smul_comm (g x) r (v x)`
    simp [Finset.smul_sum, fun x => smul_comm (g x) r (v x)]
#align fintype.total Fintype.total

variable {S}

theorem Fintype.total_apply (f) : Fintype.total R S v f = ∑ i, f i • v i :=
  rfl
#align fintype.total_apply Fintype.total_apply

@[simp]
theorem Fintype.total_apply_single (i : α) (r : R) :
    Fintype.total R S v (Pi.single i r) = r • v i := by
  simp_rw [Fintype.total_apply, Pi.single_apply, ite_smul, zero_smul]
  rw [Finset.sum_ite_eq', if_pos (Finset.mem_univ _)]
#align fintype.total_apply_single Fintype.total_apply_single

variable (S)

theorem Finsupp.total_eq_fintype_total_apply (x : α → R) :
    Finsupp.total α M R v ((Finsupp.linearEquivFunOnFinite R R α).symm x) = Fintype.total R S v x :=
  by
  apply Finset.sum_subset
  · exact Finset.subset_univ _
  · intro x _ hx
    rw [Finsupp.not_mem_support_iff.mp hx]
    exact zero_smul _ _
#align finsupp.total_eq_fintype_total_apply Finsupp.total_eq_fintype_total_apply

theorem Finsupp.total_eq_fintype_total :
    (Finsupp.total α M R v).comp (Finsupp.linearEquivFunOnFinite R R α).symm.toLinearMap =
      Fintype.total R S v :=
  LinearMap.ext <| Finsupp.total_eq_fintype_total_apply R S v
#align finsupp.total_eq_fintype_total Finsupp.total_eq_fintype_total

variable {S}

@[simp]
theorem Fintype.range_total :
    LinearMap.range (Fintype.total R S v) = Submodule.span R (Set.range v) := by
  rw [← Finsupp.total_eq_fintype_total, LinearMap.range_comp, LinearEquiv.range,
    Submodule.map_top, Finsupp.range_total]
#align fintype.range_total Fintype.range_total

section SpanRange

variable {v} {x : M}

/-- An element `x` lies in the span of `v` iff it can be written as sum `∑ cᵢ • vᵢ = x`.
-/
theorem mem_span_range_iff_exists_fun :
    x ∈ span R (range v) ↔ ∃ c : α → R, (∑ i, c i • v i) = x := by
  -- Porting note: `Finsupp.equivFunOnFinite.surjective.exists` should be come before `simp`.
  rw [Finsupp.equivFunOnFinite.surjective.exists]
  simp [Finsupp.mem_span_range_iff_exists_finsupp, Finsupp.equivFunOnFinite_apply]
  exact exists_congr fun c => Eq.congr_left <| Finsupp.sum_fintype _ _ fun i => zero_smul _ _
#align mem_span_range_iff_exists_fun mem_span_range_iff_exists_fun

/-- A family `v : α → V` is generating `V` iff every element `(x : V)`
can be written as sum `∑ cᵢ • vᵢ = x`.
-/
theorem top_le_span_range_iff_forall_exists_fun :
    ⊤ ≤ span R (range v) ↔ ∀ x, ∃ c : α → R, (∑ i, c i • v i) = x := by
  simp_rw [← mem_span_range_iff_exists_fun]
  exact ⟨fun h x => h trivial, fun h x _ => h x⟩
#align top_le_span_range_iff_forall_exists_fun top_le_span_range_iff_forall_exists_fun

end SpanRange

end Fintype

variable {R : Type _} {M : Type _} {N : Type _}

variable [Semiring R] [AddCommMonoid M] [Module R M] [AddCommMonoid N] [Module R N]

section

variable (R)

-- Porting note: `irreducible_def` produces a structure.
--               When a structure is defined, an injectivity theorem of the constructor is
--               generated, which has `simp` attr, but this get a `simpNF` linter.
--               So, this option is required.
set_option genInjectivity false in
/-- Pick some representation of `x : span R w` as a linear combination in `w`,
using the axiom of choice.
-/
irreducible_def Span.repr (w : Set M) (x : span R w) : w →₀ R :=
  ((Finsupp.mem_span_iff_total _ _ _).mp x.2).choose
#align span.repr Span.repr

@[simp]
theorem Span.finsupp_total_repr {w : Set M} (x : span R w) :
    Finsupp.total w M R (↑) (Span.repr R w x) = x := by
  rw [Span.repr_def]
  exact ((Finsupp.mem_span_iff_total _ _ _).mp x.2).choose_spec
#align span.finsupp_total_repr Span.finsupp_total_repr

end

protected theorem Submodule.finsupp_sum_mem {ι β : Type _} [Zero β] (S : Submodule R M) (f : ι →₀ β)
    (g : ι → β → M) (h : ∀ c, f c ≠ 0 → g c (f c) ∈ S) : f.sum g ∈ S :=
  AddSubmonoidClass.finsupp_sum_mem S f g h
#align submodule.finsupp_sum_mem Submodule.finsupp_sum_mem

theorem LinearMap.map_finsupp_total (f : M →ₗ[R] N) {ι : Type _} {g : ι → M} (l : ι →₀ R) :
    f (Finsupp.total ι M R g l) = Finsupp.total ι N R (f ∘ g) l := by
  -- Porting note: `(· ∘ ·)` is required.
  simp only [Finsupp.total_apply, Finsupp.total_apply, Finsupp.sum, f.map_sum, f.map_smul, (· ∘ ·)]
#align linear_map.map_finsupp_total LinearMap.map_finsupp_total

theorem Submodule.exists_finset_of_mem_supᵢ {ι : Sort _} (p : ι → Submodule R M) {m : M}
    (hm : m ∈ ⨆ i, p i) : ∃ s : Finset ι, m ∈ ⨆ i ∈ s, p i := by
  have :=
    CompleteLattice.IsCompactElement.exists_finset_of_le_supᵢ (Submodule R M)
      (Submodule.singleton_span_isCompactElement m) p
  simp only [Submodule.span_singleton_le_iff_mem] at this
  exact this hm
#align submodule.exists_finset_of_mem_supr Submodule.exists_finset_of_mem_supᵢ

/-- `Submodule.exists_finset_of_mem_supᵢ` as an `iff` -/
theorem Submodule.mem_supᵢ_iff_exists_finset {ι : Sort _} {p : ι → Submodule R M} {m : M} :
    (m ∈ ⨆ i, p i) ↔ ∃ s : Finset ι, m ∈ ⨆ i ∈ s, p i :=
  ⟨Submodule.exists_finset_of_mem_supᵢ p, fun ⟨_, hs⟩ =>
    supᵢ_mono (fun i => (supᵢ_const_le : _ ≤ p i)) hs⟩
#align submodule.mem_supr_iff_exists_finset Submodule.mem_supᵢ_iff_exists_finset

theorem mem_span_finset {s : Finset M} {x : M} :
    x ∈ span R (↑s : Set M) ↔ ∃ f : M → R, (∑ i in s, f i • i) = x :=
  ⟨fun hx =>
    let ⟨v, hvs, hvx⟩ :=
      (Finsupp.mem_span_image_iff_total _).1
        (show x ∈ span R (_root_.id '' (↑s : Set M)) by rwa [Set.image_id])
    ⟨v, hvx ▸ (Finsupp.total_apply_of_mem_supported _ hvs).symm⟩,
    fun ⟨f, hf⟩ => hf ▸ sum_mem fun i hi => smul_mem _ _ <| subset_span hi⟩
#align mem_span_finset mem_span_finset

/-- An element `m ∈ M` is contained in the `R`-submodule spanned by a set `s ⊆ M`, if and only if
`m` can be written as a finite `R`-linear combination of elements of `s`.
The implementation uses `Finsupp.sum`. -/
theorem mem_span_set {m : M} {s : Set M} :
    m ∈ Submodule.span R s ↔
      ∃ c : M →₀ R, (c.support : Set M) ⊆ s ∧ (c.sum fun mi r => r • mi) = m := by
  conv_lhs => rw [← Set.image_id s]
  -- Porting note: `simp_rw [← exists_prop]` is not necessary because of the
  --               new definition of `∃ x, p x`.
  exact Finsupp.mem_span_image_iff_total R (v := _root_.id (α := M))
#align mem_span_set mem_span_set

/-- If `Subsingleton R`, then `M ≃ₗ[R] ι →₀ R` for any type `ι`. -/
@[simps]
def Module.subsingletonEquiv (R M ι : Type _) [Semiring R] [Subsingleton R] [AddCommMonoid M]
    [Module R M] : M ≃ₗ[R] ι →₀ R where
  toFun _ := 0
  invFun _ := 0
  left_inv m := by
    letI := Module.subsingleton R M
    simp only [eq_iff_true_of_subsingleton]
  right_inv f := by simp only [eq_iff_true_of_subsingleton]
  map_add' _ _ := (add_zero 0).symm
  map_smul' r _ := (smul_zero r).symm
#align module.subsingleton_equiv Module.subsingletonEquiv

namespace LinearMap

variable {α : Type _}

open Finsupp Function

-- See also `LinearMap.splittingOfFunOnFintypeSurjective`
/-- A surjective linear map to finitely supported functions has a splitting. -/
def splittingOfFinsuppSurjective (f : M →ₗ[R] α →₀ R) (s : Surjective f) : (α →₀ R) →ₗ[R] M :=
  Finsupp.lift _ _ _ fun x : α => (s (Finsupp.single x 1)).choose
#align linear_map.splitting_of_finsupp_surjective LinearMap.splittingOfFinsuppSurjective

theorem splittingOfFinsuppSurjective_splits (f : M →ₗ[R] α →₀ R) (s : Surjective f) :
    f.comp (splittingOfFinsuppSurjective f s) = LinearMap.id := by
  -- Porting note: `ext` can't find appropriate theorems.
  refine lhom_ext' fun x => ext_ring <| Finsupp.ext fun y => ?_
  dsimp [splittingOfFinsuppSurjective]
  congr
  rw [sum_single_index, one_smul]
  · exact (s (Finsupp.single x 1)).choose_spec
  · rw [zero_smul]
#align linear_map.splitting_of_finsupp_surjective_splits LinearMap.splittingOfFinsuppSurjective_splits

theorem leftInverse_splittingOfFinsuppSurjective (f : M →ₗ[R] α →₀ R) (s : Surjective f) :
    LeftInverse f (splittingOfFinsuppSurjective f s) := fun g =>
  LinearMap.congr_fun (splittingOfFinsuppSurjective_splits f s) g
#align linear_map.left_inverse_splitting_of_finsupp_surjective LinearMap.leftInverse_splittingOfFinsuppSurjective

theorem splittingOfFinsuppSurjective_injective (f : M →ₗ[R] α →₀ R) (s : Surjective f) :
    Injective (splittingOfFinsuppSurjective f s) :=
  (leftInverse_splittingOfFinsuppSurjective f s).injective
#align linear_map.splitting_of_finsupp_surjective_injective LinearMap.splittingOfFinsuppSurjective_injective

-- See also `LinearMap.splittingOfFinsuppSurjective`
/-- A surjective linear map to functions on a finite type has a splitting. -/
def splittingOfFunOnFintypeSurjective [Fintype α] (f : M →ₗ[R] α → R) (s : Surjective f) :
    (α → R) →ₗ[R] M :=
  (Finsupp.lift _ _ _ fun x : α => (s (Finsupp.single x 1)).choose).comp
    (linearEquivFunOnFinite R R α).symm.toLinearMap
#align linear_map.splitting_of_fun_on_fintype_surjective LinearMap.splittingOfFunOnFintypeSurjective

theorem splittingOfFunOnFintypeSurjective_splits [Fintype α] (f : M →ₗ[R] α → R)
    (s : Surjective f) : f.comp (splittingOfFunOnFintypeSurjective f s) = LinearMap.id := by
  -- Porting note: `ext` can't find appropriate theorems.
  refine pi_ext' fun x => ext_ring <| funext fun y => ?_
  dsimp [splittingOfFunOnFintypeSurjective]
  rw [linearEquivFunOnFinite_symm_single, Finsupp.sum_single_index, one_smul,
    (s (Finsupp.single x 1)).choose_spec, Finsupp.single_eq_pi_single]
  rw [zero_smul]
#align linear_map.splitting_of_fun_on_fintype_surjective_splits LinearMap.splittingOfFunOnFintypeSurjective_splits

theorem leftInverse_splittingOfFunOnFintypeSurjective [Fintype α] (f : M →ₗ[R] α → R)
    (s : Surjective f) : LeftInverse f (splittingOfFunOnFintypeSurjective f s) := fun g =>
  LinearMap.congr_fun (splittingOfFunOnFintypeSurjective_splits f s) g
#align linear_map.left_inverse_splitting_of_fun_on_fintype_surjective LinearMap.leftInverse_splittingOfFunOnFintypeSurjective

theorem splittingOfFunOnFintypeSurjective_injective [Fintype α] (f : M →ₗ[R] α → R)
    (s : Surjective f) : Injective (splittingOfFunOnFintypeSurjective f s) :=
  (leftInverse_splittingOfFunOnFintypeSurjective f s).injective
#align linear_map.splitting_of_fun_on_fintype_surjective_injective LinearMap.splittingOfFunOnFintypeSurjective_injective

end LinearMap


/-
Copyright (c) 2019 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl
-/
import measure_theory.measure.measure_space

/-!
# Unsigned Hahn decomposition theorem

This file proves the unsigned version of the Hahn decomposition theorem.

## Main statements

* `hahn_decomposition` : Given two finite measures `μ` and `ν`, there exists a measurable set `s`
    such that any measurable set `t` included in `s` satisfies `ν t ≤ μ t`, and any
    measurable set `u` included in the complement of `s` satisfies `μ u ≤ ν u`.

## Tags

Hahn decomposition
-/

open set filter
open_locale classical topology ennreal

namespace measure_theory

variables {α : Type*} [measurable_space α] {μ ν : measure α}

/-- **Hahn decomposition theorem** -/
lemma hahn_decomposition [is_finite_measure μ] [is_finite_measure ν] :
  ∃s, measurable_set s ∧
    (∀t, measurable_set t → t ⊆ s → ν t ≤ μ t) ∧
    (∀t, measurable_set t → t ⊆ sᶜ → μ t ≤ ν t) :=
begin
  let d : set α → ℝ := λs, ((μ s).to_nnreal : ℝ) - (ν s).to_nnreal,
  let c : set ℝ := d '' {s | measurable_set s },
  let γ : ℝ := Sup c,

  have hμ : ∀ s, μ s ≠ ∞ := measure_ne_top μ,
  have hν : ∀ s, ν s ≠ ∞ := measure_ne_top ν,
  have to_nnreal_μ : ∀s, ((μ s).to_nnreal : ℝ≥0∞) = μ s :=
    (assume s, ennreal.coe_to_nnreal $ hμ _),
  have to_nnreal_ν : ∀s, ((ν s).to_nnreal : ℝ≥0∞) = ν s :=
    (assume s, ennreal.coe_to_nnreal $ hν _),

  have d_empty : d ∅ = 0,
  { change _ - _ = _, rw [measure_empty, measure_empty, sub_self] },

  have d_split : ∀s t, measurable_set s → measurable_set t →
    d s = d (s \ t) + d (s ∩ t),
  { assume s t hs ht,
    simp only [d],
    rw [← measure_inter_add_diff s ht, ← measure_inter_add_diff s ht,
      ennreal.to_nnreal_add (hμ _) (hμ _), ennreal.to_nnreal_add (hν _) (hν _),
      nnreal.coe_add, nnreal.coe_add],
    simp only [sub_eq_add_neg, neg_add],
    abel },

  have d_Union : ∀(s : ℕ → set α), monotone s →
    tendsto (λn, d (s n)) at_top (𝓝 (d (⋃n, s n))),
  { assume s hm,
    refine tendsto.sub _ _;
      refine (nnreal.tendsto_coe.2 $ (ennreal.tendsto_to_nnreal _).comp $
        tendsto_measure_Union hm),
    exact hμ _,
    exact hν _ },

  have d_Inter : ∀(s : ℕ → set α), (∀n, measurable_set (s n)) → (∀n m, n ≤ m → s m ⊆ s n) →
    tendsto (λn, d (s n)) at_top (𝓝 (d (⋂n, s n))),
  { assume s hs hm,
    refine tendsto.sub _ _;
      refine (nnreal.tendsto_coe.2 $ (ennreal.tendsto_to_nnreal $ _).comp $
        tendsto_measure_Inter hs hm _),
    exacts [hμ _, ⟨0, hμ _⟩, hν _, ⟨0, hν _⟩] },

  have bdd_c : bdd_above c,
  { use (μ univ).to_nnreal,
    rintros r ⟨s, hs, rfl⟩,
    refine le_trans (sub_le_self _ $ nnreal.coe_nonneg _) _,
    rw [nnreal.coe_le_coe, ← ennreal.coe_le_coe, to_nnreal_μ, to_nnreal_μ],
    exact measure_mono (subset_univ _) },

  have c_nonempty : c.nonempty := nonempty.image _ ⟨_, measurable_set.empty⟩,

  have d_le_γ : ∀s, measurable_set s → d s ≤ γ := assume s hs, le_cSup bdd_c ⟨s, hs, rfl⟩,

  have : ∀n:ℕ, ∃s : set α, measurable_set s ∧ γ - (1/2)^n < d s,
  { assume n,
    have : γ - (1/2)^n < γ := sub_lt_self γ (pow_pos (half_pos zero_lt_one) n),
    rcases exists_lt_of_lt_cSup c_nonempty this with ⟨r, ⟨s, hs, rfl⟩, hlt⟩,
    exact ⟨s, hs, hlt⟩ },
  rcases classical.axiom_of_choice this with ⟨e, he⟩,
  change ℕ → set α at e,
  have he₁ : ∀n, measurable_set (e n) := assume n, (he n).1,
  have he₂ : ∀n, γ - (1/2)^n < d (e n) := assume n, (he n).2,

  let f : ℕ → ℕ → set α := λn m, (finset.Ico n (m + 1)).inf e,

  have hf : ∀n m, measurable_set (f n m),
  { assume n m,
    simp only [f, finset.inf_eq_infi],
    exact measurable_set.bInter (to_countable _) (assume i _, he₁ _) },

  have f_subset_f : ∀{a b c d}, a ≤ b → c ≤ d → f a d ⊆ f b c,
  { assume a b c d hab hcd,
    dsimp only [f],
    rw [finset.inf_eq_infi, finset.inf_eq_infi],
    exact bInter_subset_bInter_left (finset.Ico_subset_Ico hab $ nat.succ_le_succ hcd) },

  have f_succ : ∀n m, n ≤ m → f n (m + 1) = f n m ∩ e (m + 1),
  { assume n m hnm,
    have : n ≤ m + 1 := le_of_lt (nat.succ_le_succ hnm),
    simp only [f],
    rw [nat.Ico_succ_right_eq_insert_Ico this, finset.inf_insert, set.inter_comm],
    refl },

  have le_d_f : ∀n m, m ≤ n → γ - 2 * ((1 / 2) ^ m) + (1 / 2) ^ n ≤ d (f m n),
  { assume n m h,
    refine nat.le_induction _ _ n h,
    { have := he₂ m,
      simp only [f],
      rw [nat.Ico_succ_singleton, finset.inf_singleton],
      linarith },
    { assume n (hmn : m ≤ n) ih,
      have : γ + (γ - 2 * (1 / 2)^m + (1 / 2) ^ (n + 1)) ≤ γ + d (f m (n + 1)),
      { calc γ + (γ - 2 * (1 / 2)^m + (1 / 2) ^ (n+1)) ≤
            γ + (γ - 2 * (1 / 2)^m + ((1 / 2) ^ n - (1/2)^(n+1))) :
          begin
            refine add_le_add_left (add_le_add_left _ _) γ,
            simp only [pow_add, pow_one, le_sub_iff_add_le],
            linarith
          end
          ... = (γ - (1 / 2)^(n+1)) + (γ - 2 * (1 / 2)^m + (1 / 2)^n) :
            by simp only [sub_eq_add_neg]; abel
          ... ≤ d (e (n + 1)) + d (f m n) : add_le_add (le_of_lt $ he₂ _) ih
          ... ≤ d (e (n + 1)) + d (f m n \ e (n + 1)) + d (f m (n + 1)) :
            by rw [f_succ _ _ hmn, d_split (f m n) (e (n + 1)) (hf _ _) (he₁ _), add_assoc]
          ... = d (e (n + 1) ∪ f m n) + d (f m (n + 1)) :
            begin
              rw [d_split (e (n + 1) ∪ f m n) (e (n + 1)),
                union_diff_left, union_inter_cancel_left],
              abel,
              exact (he₁ _).union (hf _ _),
              exact (he₁ _)
            end
          ... ≤ γ + d (f m (n + 1)) :
            add_le_add_right (d_le_γ _ $ (he₁ _).union (hf _ _)) _ },
      exact (add_le_add_iff_left γ).1 this } },

  let s := ⋃ m, ⋂n, f m n,
  have γ_le_d_s : γ ≤ d s,
  { have hγ : tendsto (λm:ℕ, γ - 2 * (1/2)^m) at_top (𝓝 γ),
    { suffices : tendsto (λm:ℕ, γ - 2 * (1/2)^m) at_top (𝓝 (γ - 2 * 0)),
      { simpa only [mul_zero, tsub_zero] },
      exact (tendsto_const_nhds.sub $ tendsto_const_nhds.mul $
        tendsto_pow_at_top_nhds_0_of_lt_1
          (le_of_lt $ half_pos $ zero_lt_one) (half_lt_self zero_lt_one)) },
    have hd : tendsto (λm, d (⋂n, f m n)) at_top (𝓝 (d (⋃ m, ⋂ n, f m n))),
    { refine d_Union _ _,
      exact assume n m hnm, subset_Inter
        (assume i, subset.trans (Inter_subset (f n) i) $ f_subset_f hnm $ le_rfl) },
    refine le_of_tendsto_of_tendsto' hγ hd (assume m, _),
    have : tendsto (λn, d (f m n)) at_top (𝓝 (d (⋂ n, f m n))),
    { refine d_Inter _ _ _,
      { assume n, exact hf _ _ },
      { assume n m hnm, exact f_subset_f le_rfl hnm } },
    refine ge_of_tendsto this (eventually_at_top.2 ⟨m, assume n hmn, _⟩),
    change γ - 2 * (1 / 2) ^ m ≤ d (f m n),
    refine le_trans _ (le_d_f _ _ hmn),
    exact le_add_of_le_of_nonneg le_rfl (pow_nonneg (le_of_lt $ half_pos $ zero_lt_one) _) },

  have hs : measurable_set s :=
    measurable_set.Union (assume n, measurable_set.Inter (assume m, hf _ _)),
  refine ⟨s, hs, _, _⟩,
  { assume t ht hts,
    have : 0 ≤ d t := ((add_le_add_iff_left γ).1 $
      calc γ + 0 ≤ d s : by rw [add_zero]; exact γ_le_d_s
        ... = d (s \ t) + d t : by rw [d_split _ _ hs ht, inter_eq_self_of_subset_right hts]
        ... ≤ γ + d t : add_le_add (d_le_γ _ (hs.diff ht)) le_rfl),
    rw [← to_nnreal_μ, ← to_nnreal_ν, ennreal.coe_le_coe, ← nnreal.coe_le_coe],
    simpa only [d, le_sub_iff_add_le, zero_add] using this },
  { assume t ht hts,
    have : d t ≤ 0,
    exact ((add_le_add_iff_left γ).1 $
      calc γ + d t ≤ d s + d t : add_le_add γ_le_d_s le_rfl
        ... = d (s ∪ t) :
          by rw [d_split _ _ (hs.union ht) ht, union_diff_right, union_inter_cancel_right,
            (subset_compl_iff_disjoint_left.1 hts).sdiff_eq_left]
        ... ≤ γ + 0 : by rw [add_zero]; exact d_le_γ _ (hs.union ht)),
    rw [← to_nnreal_μ, ← to_nnreal_ν, ennreal.coe_le_coe, ← nnreal.coe_le_coe],
    simpa only [d, sub_le_iff_le_add, zero_add] using this }
end

end measure_theory


/-
Copyright (c) 2021 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import data.equiv.basic

/-!
# Extra lemmas about `ulift` and `plift`

In this file we provide `subsingleton`, `unique`, `decidable_eq`, and `is_empty` instances for
`ulift α` and `plift α`. We also prove `ulift.forall`, `ulift.exists`, `plift.forall`, and
`plift.exists`.
-/

universes u v

namespace plift

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

instance [subsingleton α] : subsingleton (plift α) := equiv.plift.subsingleton
instance [unique α] : unique (plift α) := equiv.plift.unique
instance [decidable_eq α] : decidable_eq (plift α) := equiv.plift.decidable_eq
instance [is_empty α] : is_empty (plift α) := equiv.plift.is_empty

@[simp] lemma «forall» {p : plift α → Prop} : (∀ x, p x) ↔ ∀ x : α, p (plift.up x) :=
equiv.plift.forall_congr_left'

@[simp] lemma «exists» {p : plift α → Prop} : (∃ x, p x) ↔ ∃ x : α, p (plift.up x) :=
equiv.plift.exists_congr_left

end plift

namespace ulift

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

instance [subsingleton α] : subsingleton (ulift α) := equiv.ulift.subsingleton
instance [unique α] : unique (ulift α) := equiv.ulift.unique
instance [decidable_eq α] : decidable_eq (ulift α) := equiv.ulift.decidable_eq
instance [is_empty α] : is_empty (ulift α) := equiv.ulift.is_empty

@[simp] lemma «forall» {p : ulift α → Prop} : (∀ x, p x) ↔ ∀ x : α, p (ulift.up x) :=
equiv.ulift.forall_congr_left'

@[simp] lemma «exists» {p : ulift α → Prop} : (∃ x, p x) ↔ ∃ x : α, p (ulift.up x) :=
equiv.ulift.exists_congr_left

end ulift