/-
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 data.finsupp.basic
import linear_algebra.pi
import linear_algebra.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 `linear_map` 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.lsubtype_domain (s : set α) : (α →₀ M) →ₗ[R] (s →₀ M)`: restriction to a subtype as a
  linear map;

* `finsupp.restrict_dom`: `finsupp.filter` as a linear map to `finsupp.supported s`;

* `finsupp.lsum`: `finsupp.sum` or `finsupp.lift_add_hom` as a `linear_map`;

* `finsupp.total α M R (v : ι → M)`: sends `l : ι → R` to the linear combination of `v i` with
  coefficients `l i`;

* `finsupp.total_on`: a restricted version of `finsupp.total` with domain `finsupp.supported R R s`
  and codomain `submodule.span R (v '' s)`;

* `finsupp.supported_equiv_finsupp`: a linear equivalence between the functions `α →₀ M` supported
  on `s` and the functions `s →₀ M`;

* `finsupp.lmap_domain`: a linear map version of `finsupp.map_domain`;

* `finsupp.dom_lcongr`: a `linear_equiv` version of `finsupp.dom_congr`;

* `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 `linear_equiv`alence between `α →₀ M` and `β →₀ N` constructed using `e : α ≃
  β` and `e' : M ≃ₗ[R] N`.

## Tags

function with finite support, module, linear algebra
-/

noncomputable theory

open set linear_map submodule

open_locale classical big_operators

namespace finsupp

variables {α : Type*} {M : Type*} {N : Type*} {P : Type*} {R : Type*} {S : Type*}
variables [semiring R] [semiring S] [add_comm_monoid M] [module R M]
variables [add_comm_monoid N] [module R N]
variables [add_comm_monoid P] [module R P]

/-- Interpret `finsupp.single a` as a linear map. -/
def lsingle (a : α) : M →ₗ[R] (α →₀ M) :=
{ map_smul' := assume a b, (smul_single _ _ _).symm, ..finsupp.single_add_hom a }

/-- Two `R`-linear maps from `finsupp X M` which agree on each `single x y` agree everywhere. -/
lemma lhom_ext ⦃φ ψ : (α →₀ M) →ₗ[R] N⦄ (h : ∀ a b, φ (single a b) = ψ (single a b)) :
  φ = ψ :=
linear_map.to_add_monoid_hom_injective $ add_hom_ext h

/-- 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)`. -/
@[ext] lemma lhom_ext' ⦃φ ψ : (α →₀ M) →ₗ[R] N⦄ (h : ∀ a, φ.comp (lsingle a) = ψ.comp (lsingle a)) :
  φ = ψ :=
lhom_ext $ λ a, linear_map.congr_fun (h a)

/-- Interpret `λ (f : α →₀ M), f a` as a linear map. -/
def lapply (a : α) : (α →₀ M) →ₗ[R] M :=
{ map_smul' := assume a b, rfl, ..finsupp.apply_add_hom a }

section lsubtype_domain
variables (s : set α)

/-- Interpret `finsupp.subtype_domain s` as a linear map. -/
def lsubtype_domain : (α →₀ M) →ₗ[R] (s →₀ M) :=
{ to_fun := subtype_domain (λx, x ∈ s),
  map_add' := λ a b, subtype_domain_add,
  map_smul' := λ c a, ext $ λ a, rfl }

lemma lsubtype_domain_apply (f : α →₀ M) :
  (lsubtype_domain s : (α →₀ M) →ₗ[R] (s →₀ M)) f = subtype_domain (λx, x ∈ s) f := rfl

end lsubtype_domain

@[simp] lemma lsingle_apply (a : α) (b : M) : (lsingle a : M →ₗ[R] (α →₀ M)) b = single a b  :=
rfl

@[simp] lemma lapply_apply (a : α) (f : α →₀ M) : (lapply a : (α →₀ M) →ₗ[R] M) f = f a  :=
rfl

@[simp] lemma ker_lsingle (a : α) : (lsingle a : M →ₗ[R] (α →₀ M)).ker = ⊥ :=
ker_eq_bot_of_injective (single_injective a)

lemma lsingle_range_le_ker_lapply (s t : set α) (h : disjoint s t) :
  (⨆a∈s, (lsingle a : M →ₗ[R] (α →₀ M)).range) ≤ (⨅a∈t, ker (lapply a)) :=
begin
  refine supr_le (assume a₁, supr_le $ assume h₁, range_le_iff_comap.2 _),
  simp only [(ker_comp _ _).symm, eq_top_iff, set_like.le_def, mem_ker, comap_infi, mem_infi],
  assume b hb a₂ h₂,
  have : a₁ ≠ a₂ := assume eq, h ⟨h₁, eq.symm ▸ h₂⟩,
  exact single_eq_of_ne this
end

lemma infi_ker_lapply_le_bot : (⨅a, ker (lapply a : (α →₀ M) →ₗ[R] M)) ≤ ⊥ :=
begin
  simp only [set_like.le_def, mem_infi, mem_ker, mem_bot, lapply_apply],
  exact assume a h, finsupp.ext h
end

lemma supr_lsingle_range : (⨆a, (lsingle a : M →ₗ[R] (α →₀ M)).range) = ⊤ :=
begin
  refine (eq_top_iff.2 $ set_like.le_def.2 $ assume f _, _),
  rw [← sum_single f],
  exact sum_mem _ (assume a ha, submodule.mem_supr_of_mem a ⟨_, rfl⟩),
end

lemma disjoint_lsingle_lsingle (s t : set α) (hs : disjoint s t) :
  disjoint (⨆a∈s, (lsingle a : M →ₗ[R] (α →₀ M)).range) (⨆a∈t, (lsingle a).range) :=
begin
  refine disjoint.mono
    (lsingle_range_le_ker_lapply _ _ $ disjoint_compl_right)
    (lsingle_range_le_ker_lapply _ _ $ disjoint_compl_right)
    (le_trans (le_infi $ assume i, _) infi_ker_lapply_le_bot),
  classical,
  by_cases his : i ∈ s,
  { by_cases hit : i ∈ t,
    { exact (hs ⟨his, hit⟩).elim },
    exact inf_le_of_right_le (infi_le_of_le i $ infi_le _ hit) },
  exact inf_le_of_left_le (infi_le_of_le i $ infi_le _ his)
end

lemma span_single_image (s : set M) (a : α) :
  submodule.span R (single a '' s) = (submodule.span R s).map (lsingle a) :=
by rw ← span_image; refl

variables (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) :=
begin
  refine ⟨ {p | ↑p.support ⊆ s }, _, _, _ ⟩,
  { assume 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_set_of_eq, mem_support_iff, zero_apply],
    assume h ha, exact (ha rfl).elim },
  { assume a p hp,
    refine subset.trans (finset.coe_subset.2 support_smul) hp }
end

variables {M}

lemma mem_supported {s : set α} (p : α →₀ M) : p ∈ (supported M R s) ↔ ↑p.support ⊆ s :=
iff.rfl

lemma mem_supported' {s : set α}  (p : α →₀ M) :
  p ∈ supported M R s ↔ ∀ x ∉ s, p x = 0 :=
by haveI := classical.dec_pred (λ (x : α), x ∈ s);
   simp [mem_supported, set.subset_def, not_imp_comm]

lemma mem_supported_support (p : α →₀ M) :
  p ∈ finsupp.supported M R (p.support : set α) :=
by rw finsupp.mem_supported

lemma 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)

lemma supported_eq_span_single (s : set α) :
  supported R R s = span R ((λ i, single i 1) '' s) :=
begin
  refine (span_eq_of_le _ _ (set_like.le_def.2 $ λ l hl, _)).symm,
  { rintro _ ⟨_, hp, rfl ⟩ , exact single_mem_supported R 1 hp },
  { rw ← l.sum_single,
    refine sum_mem _ (λ i il, _),
    convert @smul_mem R (α →₀ R) _ _ _ _ (single i 1) (l i) _,
    { simp },
    apply subset_span,
    apply set.mem_image_of_mem _ (hl il) }
end

variables (M R)

/-- Interpret `finsupp.filter s` as a linear map from `α →₀ M` to `supported M R s`. -/
def restrict_dom (s : set α) : (α →₀ M) →ₗ[R] supported M R s :=
linear_map.cod_restrict _
  { to_fun := filter (∈ s),
    map_add' := λ l₁ l₂, filter_add,
    map_smul' := λ a l, filter_smul }
  (λ l, (mem_supported' _ _).2 $ λ x, filter_apply_neg (∈ s) l)

variables {M R}

section
@[simp] theorem restrict_dom_apply (s : set α) (l : α →₀ M) :
  ((restrict_dom M R s : (α →₀ M) →ₗ[R] supported M R s) l : α →₀ M) = finsupp.filter (∈ s) l := rfl
end

theorem restrict_dom_comp_subtype (s : set α) :
  (restrict_dom M R s).comp (submodule.subtype _) = linear_map.id :=
begin
  ext l a,
  by_cases a ∈ s; simp [h],
  exact ((mem_supported' R l.1).1 l.2 a h).symm
end

theorem range_restrict_dom (s : set α) :
  (restrict_dom M R s).range = ⊤ :=
range_eq_top.2 $ function.right_inverse.surjective $
  linear_map.congr_fun (restrict_dom_comp_subtype s)

theorem supported_mono {s t : set α} (st : s ⊆ t) :
  supported M R s ≤ supported M R t :=
λ l h, set.subset.trans h st

@[simp] theorem supported_empty : supported M R (∅ : set α) = ⊥ :=
eq_bot_iff.2 $ λ l h, (submodule.mem_bot R).2 $
by ext; simp [*, mem_supported'] at *

@[simp] theorem supported_univ : supported M R (set.univ : set α) = ⊤ :=
eq_top_iff.2 $ λ l _, set.subset_univ _

theorem supported_Union {δ : Type*} (s : δ → set α) :
  supported M R (⋃ i, s i) = ⨆ i, supported M R (s i) :=
begin
  refine le_antisymm _ (supr_le $ λ i, supported_mono $ set.subset_Union _ _),
  haveI := classical.dec_pred (λ x, x ∈ (⋃ i, s i)),
  suffices : ((submodule.subtype _).comp (restrict_dom M R (⋃ i, s i))).range ≤
    ⨆ i, supported M R (s i),
  { rwa [linear_map.range_comp, range_restrict_dom, map_top, range_subtype] at this },
  rw [range_le_iff_comap, eq_top_iff],
  rintro l ⟨⟩,
  apply finsupp.induction l, {exact zero_mem _},
  refine λ x a l hl a0, add_mem _ _,
  by_cases (∃ i, x ∈ s i); simp [h],
  { cases h with i hi,
    exact le_supr (λ i, supported M R (s i)) i (single_mem_supported R _ hi) }
end

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, supr_bool_eq]; refl

theorem supported_Inter {ι : Type*} (s : ι → set α) :
  supported M R (⋂ i, s i) = ⨅ i, supported M R (s i) :=
submodule.ext $ λ x, by simp [mem_supported, subset_Inter_iff]

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, infi_bool_eq]; refl

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]

theorem disjoint_supported_supported_iff [nontrivial M] {s t : set α} :
  disjoint (supported M R s) (supported M R t) ↔ disjoint s t :=
begin
  refine ⟨λ h x hx, _, disjoint_supported_supported⟩,
  rcases exists_ne (0 : M) with ⟨y, hy⟩,
  have := h ⟨single_mem_supported R y hx.1, single_mem_supported R y hx.2⟩,
  rw [mem_bot, single_eq_zero] at this,
  exact hy this
end

/-- Interpret `finsupp.restrict_support_equiv` as a linear equivalence between
`supported M R s` and `s →₀ M`. -/
def supported_equiv_finsupp (s : set α) : (supported M R s) ≃ₗ[R] (s →₀ M) :=
begin
  let F : (supported M R s) ≃ (s →₀ M) := restrict_support_equiv s M,
  refine F.to_linear_equiv _,
  have : (F : (supported M R s) → (↥s →₀ M)) = ((lsubtype_domain s : (α →₀ M) →ₗ[R] (s →₀ M)).comp
    (submodule.subtype (supported M R s))) := rfl,
  rw this,
  exact linear_map.is_linear _
end

section lsum

variables (S) [module S N] [smul_comm_class 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.lift_add_hom`.

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) :=
{ to_fun := λ F,
  { to_fun := λ d, d.sum (λ i, F i),
    map_add' := (lift_add_hom (λ x, (F x).to_add_monoid_hom)).map_add,
    map_smul' := λ c f, by simp [sum_smul_index', smul_sum] },
  inv_fun := λ 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 } }

@[simp] lemma coe_lsum (f : α → M →ₗ[R] N) : (lsum S f : (α →₀ M) → N) = λ d, d.sum (λ i, f i) :=
rfl

theorem lsum_apply (f : α → M →ₗ[R] N) (l : α →₀ M) :
  finsupp.lsum S f l = l.sum (λ b, f b) := rfl

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

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

end lsum

section
variables (M) (R) (X : Type*)

/--
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) :=
(add_equiv.arrow_congr (equiv.refl X) (ring_lmap_equiv_self R ℕ M).to_add_equiv.symm).trans
  (lsum _ : _ ≃ₗ[ℕ] _).to_add_equiv

@[simp]
lemma lift_symm_apply (f) (x) : ((lift M R X).symm f) x = f (single x 1) :=
rfl
@[simp]
lemma lift_apply (f) (g) :
  ((lift M R X) f) g = g.sum (λ x r, r • f x) :=
rfl

end

section lmap_domain
variables {α' : Type*} {α'' : Type*} (M R)

/-- Interpret `finsupp.map_domain` as a linear map. -/
def lmap_domain (f : α → α') : (α →₀ M) →ₗ[R] (α' →₀ M) :=
{ to_fun := map_domain f, map_add' := λ a b, map_domain_add, map_smul' := map_domain_smul }

@[simp] theorem lmap_domain_apply (f : α → α') (l : α →₀ M) :
  (lmap_domain M R f : (α →₀ M) →ₗ[R] (α' →₀ M)) l = map_domain f l := rfl

@[simp] theorem lmap_domain_id : (lmap_domain M R id : (α →₀ M) →ₗ[R] α →₀ M) = linear_map.id :=
linear_map.ext $ λ l, map_domain_id

theorem lmap_domain_comp (f : α → α') (g : α' → α'') :
  lmap_domain M R (g ∘ f) = (lmap_domain M R g).comp (lmap_domain M R f) :=
linear_map.ext $ λ l, map_domain_comp

theorem supported_comap_lmap_domain (f : α → α') (s : set α') :
  supported M R (f ⁻¹' s) ≤ (supported M R s).comap (lmap_domain M R f) :=
λ l (hl : ↑l.support ⊆ f ⁻¹' s),
show ↑(map_domain f l).support ⊆ s, begin
  rw [← set.image_subset_iff, ← finset.coe_image] at hl,
  exact set.subset.trans map_domain_support hl
end

theorem lmap_domain_supported [nonempty α] (f : α → α') (s : set α) :
  (supported M R s).map (lmap_domain M R f) = supported M R (f '' s) :=
begin
  inhabit α,
  refine le_antisymm (map_le_iff_le_comap.2 $
    le_trans (supported_mono $ set.subset_preimage_image _ _)
       (supported_comap_lmap_domain _ _ _ _)) _,
  intros l hl,
  refine ⟨(lmap_domain M R (function.inv_fun_on f s) : (α' →₀ M) →ₗ[R] α →₀ M) l, λ x hx, _, _⟩,
  { rcases finset.mem_image.1 (map_domain_support hx) with ⟨c, hc, rfl⟩,
    exact function.inv_fun_on_mem (by simpa using hl hc) },
  { rw [← linear_map.comp_apply, ← lmap_domain_comp],
    refine (map_domain_congr $ λ c hc, _).trans map_domain_id,
    exact function.inv_fun_on_eq (by simpa using hl hc) }
end

theorem lmap_domain_disjoint_ker (f : α → α') {s : set α}
  (H : ∀ a b ∈ s, f a = f b → a = b) :
  disjoint (supported M R s) (lmap_domain M R f).ker :=
begin
  rintro l ⟨h₁, h₂⟩,
  rw [set_like.mem_coe, mem_ker, lmap_domain_apply, map_domain] at h₂,
  simp, ext x,
  haveI := classical.dec_pred (λ x, x ∈ s),
  by_cases xs : x ∈ s,
  { have : finsupp.sum l (λ a, finsupp.single (f a)) (f x) = 0, {rw h₂, refl},
    rw [finsupp.sum_apply, finsupp.sum, finset.sum_eq_single x] at this,
    { simpa [finsupp.single_apply] },
    { intros y hy xy, simp [mt (H _ (h₁ hy) _ xs) xy] },
    { simp {contextual := tt} } },
  { by_contra h, exact xs (h₁ $ finsupp.mem_support_iff.2 h) }
end

end lmap_domain

section total
variables (α) {α' : Type*} (M) {M' : Type*} (R)
          [add_comm_monoid 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 ℕ (λ i, linear_map.id.smul_right (v i))

variables {α M v}

theorem total_apply (l : α →₀ R) :
  finsupp.total α M R v l = l.sum (λ i a, a • v i) := rfl

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 (λ i, l i • v i) :=
finset.sum_subset hs $ λ x _ hxg, show l x • v x = 0, by rw [not_mem_support_iff.1 hxg, zero_smul]

@[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]

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 { contextual := tt, }

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

lemma total_surjective (h : function.surjective v) : function.surjective (finsupp.total α M R v) :=
begin
  intro x,
  obtain ⟨y, hy⟩ := h x,
  exact ⟨finsupp.single y 1, by simp [hy]⟩
end

theorem total_range (h : function.surjective v) : (finsupp.total α M R v).range = ⊤ :=
range_eq_top.2 $ total_surjective R h

/-- 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`. -/
lemma total_id_surjective (M) [add_comm_monoid M] [module R M] :
  function.surjective (finsupp.total M M R id) :=
total_surjective R function.surjective_id

lemma range_total : (finsupp.total α M R v).range = span R (range v) :=
begin
  ext x,
  split,
  { intros hx,
    rw [linear_map.mem_range] at hx,
    rcases hx with ⟨l, hl⟩,
    rw ← hl,
    rw finsupp.total_apply,
    unfold finsupp.sum,
    apply sum_mem (span R (range v)),
    exact λ i hi, submodule.smul_mem _ _ (subset_span (mem_range_self i)) },
  { apply span_le.2,
    intros x hx,
    rcases hx with ⟨i, hi⟩,
    rw [set_like.mem_coe, linear_map.mem_range],
    use finsupp.single i 1,
    simp [hi] }
end

theorem lmap_domain_total (f : α → α') (g : M →ₗ[R] M') (h : ∀ i, g (v i) = v' (f i)) :
  (finsupp.total α' M' R v').comp (lmap_domain R R f) = g.comp (finsupp.total α M R v) :=
by ext l; simp [total_apply, finsupp.sum_map_domain_index, add_smul, h]

@[simp] theorem total_emb_domain (f : α ↪ α') (l : α →₀ R) :
  (finsupp.total α' M' R v') (emb_domain f l) = (finsupp.total α M' R (v' ∘ f)) l :=
by simp [total_apply, finsupp.sum, support_emb_domain, emb_domain_apply]

@[simp] theorem total_equiv_map_domain (f : α ≃ α') (l : α →₀ R) :
  (finsupp.total α' M' R v') (equiv_map_domain f l) = (finsupp.total α M' R (v' ∘ f)) l :=
by rw [equiv_map_domain_eq_map_domain, total_map_domain _ _ f.injective]

/-- 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 = (finsupp.total s M R coe).range :=
by rw [range_total, subtype.range_coe_subtype, set.set_of_mem_eq]

theorem mem_span_iff_total (s : set M) (x : M) :
  x ∈ span R s ↔ ∃ l : s →₀ R, finsupp.total s M R coe l = x :=
(set_like.ext_iff.1 $ span_eq_range_total _ _) x

theorem span_image_eq_map_total (s : set α):
  span R (v '' s) = submodule.map (finsupp.total α M R v) (supported R R s) :=
begin
  apply span_eq_of_le,
  { intros x hx,
    rw set.mem_image at hx,
    apply exists.elim hx,
    intros i hi,
    exact ⟨_, finsupp.single_mem_supported R 1 hi.1, by simp [hi.2]⟩ },
  { refine map_le_iff_le_comap.2 (λ z hz, _),
    have : ∀i, z i • v i ∈ span R (v '' s),
    { intro c,
      haveI := classical.dec_pred (λ x, x ∈ s),
      by_cases c ∈ s,
      { exact smul_mem _ _ (subset_span (set.mem_image_of_mem _ h)) },
      { simp [(finsupp.mem_supported' R _).1 hz _ h] } },
    refine sum_mem _ _, simp [this] }
end

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, }

lemma 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]

lemma total_total {α β : Type*} (A : α → M) (B : β → (α →₀ R)) (f : β →₀ R) :
  finsupp.total α M R A (finsupp.total β (α →₀ R) R B f) =
    finsupp.total β M R (λ b, finsupp.total α M R A (B b)) f :=
begin
  simp only [total_apply],
  apply induction_linear f,
  { simp only [sum_zero_index], },
  { intros f₁ f₂ h₁ h₂,
    simp [sum_add_index, h₁, h₂, add_smul], },
  { simp [sum_single_index, sum_smul_index, smul_sum, mul_smul], }
end

@[simp] lemma total_fin_zero (f : fin 0 → M) :
  finsupp.total (fin 0) M R f = 0 :=
by { ext i, apply fin_zero_elim i }

variables (α) (M) (v)

/-- `finsupp.total_on 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 total_on (s : set α) : supported R R s →ₗ[R] span R (v '' s) :=
linear_map.cod_restrict _ ((finsupp.total _ _ _ v).comp (submodule.subtype (supported R R s))) $
  λ ⟨l, hl⟩, (mem_span_image_iff_total _).2 ⟨l, hl, rfl⟩

variables {α} {M} {v}

theorem total_on_range (s : set α) : (finsupp.total_on α M R v s).range = ⊤ :=
begin
  rw [finsupp.total_on, linear_map.range_eq_map, linear_map.map_cod_restrict,
    ← linear_map.range_le_iff_comap, range_subtype, map_top, linear_map.range_comp, range_subtype],
  exact (span_image_eq_map_total _ _).le
end

theorem total_comp (f : α' → α) :
  (finsupp.total α' M R (v ∘ f)) = (finsupp.total α M R v).comp (lmap_domain R R f) :=
by { ext, simp [total_apply] }

lemma total_comap_domain
 (f : α → α') (l : α' →₀ R) (hf : set.inj_on f (f ⁻¹' ↑l.support)) :
 finsupp.total α M R v (finsupp.comap_domain f l hf) =
   (l.support.preimage f hf).sum (λ i, (l (f i)) • (v i)) :=
by rw finsupp.total_apply; refl

lemma total_on_finset
  {s : finset α} {f : α → R} (g : α → M) (hf : ∀ a, f a ≠ 0 → a ∈ s):
  finsupp.total α M R g (finsupp.on_finset s f hf) =
    finset.sum s (λ (x : α), f x • g x) :=
begin
  simp only [finsupp.total_apply, finsupp.sum, finsupp.on_finset_apply, finsupp.support_on_finset],
  rw finset.sum_filter_of_ne,
  intros x hx h,
  contrapose! h,
  simp [h],
end

end total

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

This is `finsupp.dom_congr` as a `linear_equiv`.
See also `linear_map.fun_congr_left` for the case of arbitrary functions. -/
protected def dom_lcongr {α₁ α₂ : Type*} (e : α₁ ≃ α₂) :
  (α₁ →₀ M) ≃ₗ[R] (α₂ →₀ M) :=
(finsupp.dom_congr e : (α₁ →₀ M) ≃+ (α₂ →₀ M)).to_linear_equiv $
by simpa only [equiv_map_domain_eq_map_domain, dom_congr_apply]
  using (lmap_domain M R e).map_smul

@[simp]
lemma dom_lcongr_apply {α₁ : Type*} {α₂ : Type*} (e : α₁ ≃ α₂) (v : α₁ →₀ M) :
  (finsupp.dom_lcongr e : _ ≃ₗ[R] _) v = finsupp.dom_congr e v :=
rfl

@[simp]
lemma dom_lcongr_refl : finsupp.dom_lcongr (equiv.refl α) = linear_equiv.refl R (α →₀ M) :=
linear_equiv.ext $ λ _, equiv_map_domain_refl _

lemma dom_lcongr_trans {α₁ α₂ α₃ : Type*} (f : α₁ ≃ α₂) (f₂ : α₂ ≃ α₃) :
  (finsupp.dom_lcongr f).trans (finsupp.dom_lcongr f₂) =
    (finsupp.dom_lcongr (f.trans f₂) : (_ →₀ M) ≃ₗ[R] _) :=
linear_equiv.ext $ λ _, (equiv_map_domain_trans _ _ _).symm

@[simp]
lemma dom_lcongr_symm {α₁ α₂ : Type*} (f : α₁ ≃ α₂) :
  ((finsupp.dom_lcongr f).symm : (_ →₀ M) ≃ₗ[R] _) = finsupp.dom_lcongr f.symm :=
linear_equiv.ext $ λ x, rfl

@[simp] theorem dom_lcongr_single {α₁ : Type*} {α₂ : Type*} (e : α₁ ≃ α₂) (i : α₁) (m : M) :
  (finsupp.dom_lcongr e : _ ≃ₗ[R] _) (finsupp.single i m) = finsupp.single (e i) m :=
by simp [finsupp.dom_lcongr, finsupp.dom_congr, equiv_map_domain_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 :=
begin
  haveI := classical.dec_pred (λ x, x ∈ s),
  haveI := classical.dec_pred (λ x, x ∈ t),
  refine (finsupp.supported_equiv_finsupp s) ≪≫ₗ
      (_ ≪≫ₗ (finsupp.supported_equiv_finsupp t).symm),
  exact finsupp.dom_lcongr e
end

/-- `finsupp.map_range` as a `linear_map`. -/
@[simps]
def map_range.linear_map (f : M →ₗ[R] N) : (α →₀ M) →ₗ[R] (α →₀ N) :=
{ to_fun := (map_range f f.map_zero : (α →₀ M) → (α →₀ N)),
  map_smul' := λ c v, map_range_smul c v (f.map_smul c),
  ..map_range.add_monoid_hom f.to_add_monoid_hom }

@[simp]
lemma map_range.linear_map_id :
  map_range.linear_map linear_map.id = (linear_map.id : (α →₀ M) →ₗ[R] _):=
linear_map.ext map_range_id

lemma map_range.linear_map_comp (f : N →ₗ[R] P) (f₂ : M →ₗ[R] N) :
  (map_range.linear_map (f.comp f₂) : (α →₀ _) →ₗ[R] _) =
    (map_range.linear_map f).comp (map_range.linear_map f₂) :=
linear_map.ext $ map_range_comp _ _ _ _ _

@[simp]
lemma map_range.linear_map_to_add_monoid_hom (f : M →ₗ[R] N) :
  (map_range.linear_map f).to_add_monoid_hom =
    (map_range.add_monoid_hom f.to_add_monoid_hom : (α →₀ M) →+ _):=
add_monoid_hom.ext $ λ _, rfl

/-- `finsupp.map_range` as a `linear_equiv`. -/
@[simps apply]
def map_range.linear_equiv (e : M ≃ₗ[R] N) : (α →₀ M) ≃ₗ[R] (α →₀ N) :=
{ to_fun := map_range e e.map_zero,
  inv_fun := map_range e.symm e.symm.map_zero,
  ..map_range.linear_map e.to_linear_map,
  ..map_range.add_equiv e.to_add_equiv}

@[simp]
lemma map_range.linear_equiv_refl :
  map_range.linear_equiv (linear_equiv.refl R M) = linear_equiv.refl R (α →₀ M) :=
linear_equiv.ext map_range_id

lemma map_range.linear_equiv_trans (f : M ≃ₗ[R] N) (f₂ : N ≃ₗ[R] P) :
  (map_range.linear_equiv (f.trans f₂) : (α →₀ _) ≃ₗ[R] _) =
    (map_range.linear_equiv f).trans (map_range.linear_equiv f₂) :=
linear_equiv.ext $ map_range_comp _ _ _ _ _

@[simp]
lemma map_range.linear_equiv_symm (f : M ≃ₗ[R] N) :
  ((map_range.linear_equiv f).symm : (α →₀ _) ≃ₗ[R] _) = map_range.linear_equiv f.symm :=
linear_equiv.ext $ λ x, rfl

@[simp]
lemma map_range.linear_equiv_to_add_equiv (f : M ≃ₗ[R] N) :
  (map_range.linear_equiv f).to_add_equiv =
    (map_range.add_equiv f.to_add_equiv : (α →₀ M) ≃+ _):=
add_equiv.ext $ λ _, rfl

@[simp]
lemma map_range.linear_equiv_to_linear_map (f : M ≃ₗ[R] N) :
  (map_range.linear_equiv f).to_linear_map =
    (map_range.linear_map f.to_linear_map : (α →₀ M) →ₗ[R] _):=
linear_map.ext $ λ _, rfl

/-- 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.dom_lcongr e₁).trans (map_range.linear_equiv e₂)

@[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]

@[simp] lemma lcongr_apply_apply {ι κ : Sort*} (e₁ : ι ≃ κ) (e₂ : M ≃ₗ[R] N) (f : ι →₀ M) (k : κ) :
  lcongr e₁ e₂ f k = e₂ (f (e₁.symm k)) :=
rfl

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) :=
begin
  apply_fun lcongr e₁ e₂ using (lcongr e₁ e₂).injective,
  simp,
end

@[simp] lemma lcongr_symm {ι κ : Sort*} (e₁ : ι ≃ κ) (e₂ : M ≃ₗ[R] N) :
  (lcongr e₁ e₂).symm = lcongr e₁.symm e₂.symm :=
begin
  ext f i,
  simp only [equiv.symm_symm, finsupp.lcongr_apply_apply],
  apply finsupp.induction_linear f,
  { simp, },
  { intros f g hf hg, simp [map_add, hf, hg], },
  { intros k m,
    simp only [finsupp.lcongr_symm_single],
    simp only [finsupp.single, equiv.symm_apply_eq, finsupp.coe_mk],
    split_ifs; simp, },
end

section sum

variables (R)

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

This is the `linear_equiv` version of `finsupp.sum_finsupp_equiv_prod_finsupp`. -/
@[simps apply symm_apply] def sum_finsupp_lequiv_prod_finsupp {α β : Type*} :
  ((α ⊕ β) →₀ M) ≃ₗ[R] (α →₀ M) × (β →₀ M) :=
{ map_smul' :=
    by { intros, ext;
          simp only [add_equiv.to_fun_eq_coe, prod.smul_fst, prod.smul_snd, smul_apply,
              snd_sum_finsupp_add_equiv_prod_finsupp, fst_sum_finsupp_add_equiv_prod_finsupp,
              ring_hom.id_apply] },
  .. sum_finsupp_add_equiv_prod_finsupp }

lemma fst_sum_finsupp_lequiv_prod_finsupp {α β : Type*}
  (f : (α ⊕ β) →₀ M) (x : α) :
  (sum_finsupp_lequiv_prod_finsupp R f).1 x = f (sum.inl x) :=
rfl

lemma snd_sum_finsupp_lequiv_prod_finsupp {α β : Type*}
  (f : (α ⊕ β) →₀ M) (y : β) :
  (sum_finsupp_lequiv_prod_finsupp R f).2 y = f (sum.inr y) :=
rfl

lemma sum_finsupp_lequiv_prod_finsupp_symm_inl {α β : Type*}
  (fg : (α →₀ M) × (β →₀ M)) (x : α) :
  ((sum_finsupp_lequiv_prod_finsupp R).symm fg) (sum.inl x) = fg.1 x :=
rfl

lemma sum_finsupp_lequiv_prod_finsupp_symm_inr {α β : Type*}
  (fg : (α →₀ M) × (β →₀ M)) (y : β) :
  ((sum_finsupp_lequiv_prod_finsupp R).symm fg) (sum.inr y) = fg.2 y :=
rfl

end sum

section sigma

variables {η : Type*} [fintype η] {ιs : η → Type*} [has_zero α]
variables (R)

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

This is the `linear_equiv` version of `finsupp.sigma_finsupp_add_equiv_pi_finsupp`. -/
noncomputable def sigma_finsupp_lequiv_pi_finsupp
  {M : Type*} {ιs : η → Type*} [add_comm_monoid M] [module R M] :
  ((Σ j, ιs j) →₀ M) ≃ₗ[R] Π j, (ιs j →₀ M) :=
{ map_smul' := λ c f, by { ext, simp },
  .. sigma_finsupp_add_equiv_pi_finsupp }

@[simp] lemma sigma_finsupp_lequiv_pi_finsupp_apply
  {M : Type*} {ιs : η → Type*} [add_comm_monoid M] [module R M]
  (f : (Σ j, ιs j) →₀ M) (j i) :
  sigma_finsupp_lequiv_pi_finsupp R f j i = f ⟨j, i⟩ := rfl

@[simp] lemma sigma_finsupp_lequiv_pi_finsupp_symm_apply
  {M : Type*} {ιs : η → Type*} [add_comm_monoid M] [module R M]
  (f : Π j, (ιs j →₀ M)) (ji) :
  (finsupp.sigma_finsupp_lequiv_pi_finsupp R).symm f ji = f ji.1 ji.2 := rfl

end sigma

section prod

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

This is the `linear_equiv` version of `finsupp.finsupp_prod_equiv`. -/
noncomputable def finsupp_prod_lequiv {α β : Type*} (R : Type*) {M : Type*}
  [semiring R] [add_comm_monoid M] [module R M] :
  (α × β →₀ M) ≃ₗ[R] (α →₀ β →₀ M) :=
{ map_add' := λ f g, by { ext, simp [finsupp_prod_equiv, curry_apply] },
  map_smul' := λ c f, by { ext, simp [finsupp_prod_equiv, curry_apply] },
  .. finsupp_prod_equiv }

@[simp] lemma finsupp_prod_lequiv_apply {α β R M : Type*}
  [semiring R] [add_comm_monoid M] [module R M] (f : α × β →₀ M) (x y) :
  finsupp_prod_lequiv R f x y = f (x, y) :=
by rw [finsupp_prod_lequiv, linear_equiv.coe_mk, finsupp_prod_equiv, finsupp.curry_apply]

@[simp] lemma finsupp_prod_lequiv_symm_apply {α β R M : Type*}
  [semiring R] [add_comm_monoid M] [module R M] (f : α →₀ β →₀ M) (xy) :
  (finsupp_prod_lequiv R).symm f xy = f xy.1 xy.2 :=
by conv_rhs
  { rw [← (finsupp_prod_lequiv R).apply_symm_apply f, finsupp_prod_lequiv_apply, prod.mk.eta] }

end prod

end finsupp

variables {R : Type*} {M : Type*} {N : Type*}
variables [semiring R] [add_comm_monoid M] [module R M] [add_comm_monoid N] [module R N]

section
variables (R)
/--
Pick some representation of `x : span R w` as a linear combination in `w`,
using the axiom of choice.
-/
def span.repr (w : set M) (x : span R w) : w →₀ R :=
((finsupp.mem_span_iff_total _ _ _).mp x.2).some

@[simp] lemma span.finsupp_total_repr {w : set M} (x : span R w) :
  finsupp.total w M R coe (span.repr R w x) = x :=
((finsupp.mem_span_iff_total _ _ _).mp x.2).some_spec

attribute [irreducible] span.repr

end

lemma submodule.finsupp_sum_mem {ι β : Type*} [has_zero β] (S : submodule R M) (f : ι →₀ β)
  (g : ι → β → M) (h : ∀ c, f c ≠ 0 → g c (f c) ∈ S) : f.sum g ∈ S :=
S.to_add_submonoid.finsupp_sum_mem f g h

lemma linear_map.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 simp only [finsupp.total_apply, finsupp.total_apply, finsupp.sum, f.map_sum, f.map_smul]

lemma submodule.exists_finset_of_mem_supr
  {ι : Sort*} (p : ι → submodule R M) {m : M} (hm : m ∈ ⨆ i, p i) :
  ∃ s : finset ι, m ∈ ⨆ i ∈ s, p i :=
begin
  obtain ⟨f, hf, rfl⟩ : ∃ f ∈ finsupp.supported R R (⋃ i, ↑(p i)), finsupp.total M M R id f = m,
  { have aux : (id : M → M) '' (⋃ (i : ι), ↑(p i)) = (⋃ (i : ι), ↑(p i)) := set.image_id _,
    rwa [supr_eq_span, ← aux, finsupp.mem_span_image_iff_total R] at hm },
  let t : finset M := f.support,
  have ht : ∀ x : {x // x ∈ t}, ∃ i, ↑x ∈ p i,
  { intros x,
    rw finsupp.mem_supported at hf,
    specialize hf x.2,
    rwa set.mem_Union at hf },
  choose g hg using ht,
  let s : finset ι := finset.univ.image g,
  use s,
  simp only [mem_supr, supr_le_iff],
  assume N hN,
  rw [finsupp.total_apply, finsupp.sum, ← set_like.mem_coe],
  apply N.sum_mem,
  assume x hx,
  apply submodule.smul_mem,
  let i : ι := g ⟨x, hx⟩,
  have hi : i ∈ s, { rw finset.mem_image, exact ⟨⟨x, hx⟩, finset.mem_univ _, rfl⟩ },
  exact hN i hi (hg _),
end

/-- `submodule.exists_finset_of_mem_supr` as an `iff` -/
lemma submodule.mem_supr_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_supr p,
 λ ⟨_, hs⟩, supr_mono (λ i, (supr_const_le : _ ≤ p i)) hs⟩

lemma mem_span_finset {s : finset M} {x : M} :
  x ∈ span R (↑s : set M) ↔ ∃ f : M → R, ∑ i in s, f i • i = x :=
⟨λ hx, let ⟨v, hvs, hvx⟩ := (finsupp.mem_span_image_iff_total _).1
    (show x ∈ span R (id '' (↑s : set M)), by rwa set.image_id) in
  ⟨v, hvx ▸ (finsupp.total_apply_of_mem_supported _ hvs).symm⟩,
λ ⟨f, hf⟩, hf ▸ sum_mem _ (λ i hi, smul_mem _ _ $ subset_span hi)⟩

/-- 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`. -/
lemma mem_span_set {m : M} {s : set M} :
  m ∈ submodule.span R s ↔ ∃ c : M →₀ R, (c.support : set M) ⊆ s ∧ c.sum (λ mi r, r • mi) = m :=
begin
  conv_lhs { rw ←set.image_id s },
  simp_rw ←exists_prop,
  exact finsupp.mem_span_image_iff_total R,
end

/-- If `subsingleton R`, then `M ≃ₗ[R] ι →₀ R` for any type `ι`. -/
@[simps]
def module.subsingleton_equiv (R M ι: Type*) [semiring R] [subsingleton R] [add_comm_monoid M]
  [module R M] : M ≃ₗ[R] ι →₀ R :=
{ to_fun := λ m, 0,
  inv_fun := λ f, 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' := λ m n, (add_zero 0).symm,
  map_smul' := λ r m, (smul_zero r).symm }

namespace linear_map

variables {R M} {α : Type*}
open finsupp function

/-- A surjective linear map to finitely supported functions has a splitting. -/
-- See also `linear_map.splitting_of_fun_on_fintype_surjective`
def splitting_of_finsupp_surjective (f : M →ₗ[R] (α →₀ R)) (s : surjective f) : (α →₀ R) →ₗ[R] M :=
finsupp.lift _ _ _ (λ x : α, (s (finsupp.single x 1)).some)

lemma splitting_of_finsupp_surjective_splits (f : M →ₗ[R] (α →₀ R)) (s : surjective f) :
  f.comp (splitting_of_finsupp_surjective f s) = linear_map.id :=
begin
  ext x y,
  dsimp [splitting_of_finsupp_surjective],
  congr,
  rw [sum_single_index, one_smul],
  { exact (s (finsupp.single x 1)).some_spec, },
  { rw zero_smul, },
end

lemma left_inverse_splitting_of_finsupp_surjective (f : M →ₗ[R] (α →₀ R)) (s : surjective f) :
  left_inverse f (splitting_of_finsupp_surjective f s) :=
λ g, linear_map.congr_fun (splitting_of_finsupp_surjective_splits f s) g

lemma splitting_of_finsupp_surjective_injective (f : M →ₗ[R] (α →₀ R)) (s : surjective f) :
  injective (splitting_of_finsupp_surjective f s) :=
(left_inverse_splitting_of_finsupp_surjective f s).injective

/-- A surjective linear map to functions on a finite type has a splitting. -/
-- See also `linear_map.splitting_of_finsupp_surjective`
def splitting_of_fun_on_fintype_surjective [fintype α] (f : M →ₗ[R] (α → R)) (s : surjective f) :
  (α → R) →ₗ[R] M :=
(finsupp.lift _ _ _ (λ x : α, (s (finsupp.single x 1)).some)).comp
  (linear_equiv_fun_on_fintype R R α).symm.to_linear_map

lemma splitting_of_fun_on_fintype_surjective_splits
  [fintype α] (f : M →ₗ[R] (α → R)) (s : surjective f) :
  f.comp (splitting_of_fun_on_fintype_surjective f s) = linear_map.id :=
begin
  ext x y,
  dsimp [splitting_of_fun_on_fintype_surjective],
  rw [linear_equiv_fun_on_fintype_symm_single, finsupp.sum_single_index, one_smul,
    (s (finsupp.single x 1)).some_spec, finsupp.single_eq_pi_single],
  rw [zero_smul],
end

lemma left_inverse_splitting_of_fun_on_fintype_surjective
  [fintype α] (f : M →ₗ[R] (α → R)) (s : surjective f) :
  left_inverse f (splitting_of_fun_on_fintype_surjective f s) :=
λ g, linear_map.congr_fun (splitting_of_fun_on_fintype_surjective_splits f s) g

lemma splitting_of_fun_on_fintype_surjective_injective
  [fintype α] (f : M →ₗ[R] (α → R)) (s : surjective f) :
  injective (splitting_of_fun_on_fintype_surjective f s) :=
(left_inverse_splitting_of_fun_on_fintype_surjective f s).injective

end linear_map


import .simplices
import algebraic_topology.alternating_face_map_complex
import algebraic_topology.simplicial_set
import algebra.category.Module.abelian
import algebra.category.Module.adjunctions
import algebra.homology.homology
import algebra.homology.Module
import algebra.homology.homotopy
import algebraic_topology.simplex_category
import algebraic_topology.topological_simplex
import category_theory.adjunction.limits
import algebra.category.Module.colimits

import for_mathlib.ab4

import .homological_algebra
import .preserves_colimits_functor_category .alternating_face_map_complex .Module_AB4

open category_theory algebraic_topology
open_locale big_operators

noncomputable
def free_complex_on_sset (R : Type*) [comm_ring R] : sSet ⥤ chain_complex (Module R) ℕ :=
  ((simplicial_object.whiskering _ _).obj (Module.free R)) ⋙ alternating_face_map_complex _

noncomputable
def singular_chain_complex (R : Type*) [comm_ring R] : Top ⥤ chain_complex (Module R) ℕ :=
  Top.to_sSet' ⋙ free_complex_on_sset R

noncomputable
def singular_chain_complex_of_pair (R : Type*) [comm_ring R]
  : arrow Top ⥤ chain_complex (Module R) ℕ :=
  category_theory.functor.map_arrow (singular_chain_complex R)
  ⋙ coker_functor (chain_complex (Module R) ℕ)

noncomputable
def singular_homology (R : Type*) [comm_ring R] (n : ℕ) : Top ⥤ Module R :=
  singular_chain_complex R ⋙ homology_functor _ _ n

noncomputable
def singular_homology_of_pair (R : Type*) [comm_ring R] (n : ℕ) : arrow Top ⥤ Module R :=
  singular_chain_complex_of_pair R ⋙ homology_functor _ _ n

noncomputable
def singular_zero_simplex_of_pt {X : Top} (x0 : X)
  : (Top.to_sSet'.obj X).obj (opposite.op (simplex_category.mk 0)) :=
  (continuous_map.const (topological_simplex 0) x0)

noncomputable
def simplex_to_chain {n : ℕ} {X : sSet}
  (σ : X.obj (opposite.op (simplex_category.mk n)))
  (R : Type*) [comm_ring R] : ((free_complex_on_sset R).obj X).X n :=
  finsupp.single σ 1

-- Should mark this as simp and use it more widely maybe?
lemma singular_chain_complex_map
  (R : Type*) [comm_ring R] (n : ℕ) {X Y : Top}
  (f : X ⟶ Y) (σ : (Top.to_sSet'.obj X).obj (opposite.op (simplex_category.mk n)))
  : ((singular_chain_complex R).map f).f n (finsupp.single σ 1)
  = finsupp.single (σ ≫ f) 1 := finsupp.map_domain_single

lemma singular_chain_complex_differential_desc (R : Type*) [comm_ring R] {X : Top} {n : ℕ}
  (σ : Top.of (topological_simplex (n + 1)) ⟶ X)
  : ((singular_chain_complex R).obj X).d (n + 1) n (finsupp.single σ 1)
  = ∑ (i : fin (n + 2)), (-1 : ℤ)^(i : ℕ)
  • simplex_to_chain (simplex_category.to_Top'.map (simplex_category.δ i) ≫ σ) R := by {
    dsimp [singular_chain_complex, free_complex_on_sset],
    transitivity (alternating_face_map_complex.obj_d
                     (((simplicial_object.whiskering Type (Module R)).obj (Module.free R)).obj
                                                                          (Top.to_sSet'.obj X)) n)
                     .to_fun
                     (finsupp.single σ 1),
    { congr, apply chain_complex.of_d },
    { simp [alternating_face_map_complex.obj_d],
      congr, ext i, congr,
      dsimp [simplex_to_chain],
      rw finsupp.eq_single_iff, split,
      { intros t h,
        rw finset.mem_singleton,
        simp at h,
        have : ((Module.free R).map ((Top.to_sSet'.obj X).δ i) (finsupp.single σ 1)).to_fun t ≠ 0 := h,
        simp at this,
        exact and.left (finsupp.single_apply_ne_zero.mp this) },
      { change (((Module.free R).map ((Top.to_sSet'.obj X).δ i) (finsupp.single σ 1)).to_fun
                  (simplex_category.to_Top'.map (simplex_category.δ i) ≫ σ) = 1),
        simp,
        exact finsupp.single_eq_same } }
  }

lemma singular_chain_complex_differential_desc_deg_0 (R : Type*) [comm_ring R] {X : Top}
  (σ : Top.of (topological_simplex 1) ⟶ X)
  : ((singular_chain_complex R).obj X).d 1 0 (finsupp.single σ 1)
  = simplex_to_chain (simplex_category.to_Top'.map (@simplex_category.δ 0 0) ≫ σ) R
  - simplex_to_chain (simplex_category.to_Top'.map (@simplex_category.δ 0 1) ≫ σ) R :=
begin
  rw singular_chain_complex_differential_desc,
  rw finset.sum_eq_add_of_mem (0 : fin 2) 1 (finset.mem_univ _) (finset.mem_univ _),
  { simp, rw sub_eq_add_neg },
  { simp },
  { intros c H' H, exfalso, cases c with c hc, cases H,
    cases c, contradiction, cases c, contradiction,
    rw [nat.succ_lt_succ_iff, nat.succ_lt_succ_iff] at hc,
    exact not_lt_zero' hc }
end

lemma singular_chain_complex_map_inj (R : Type*) [comm_ring R] {X Y : Top}
  (f : X ⟶ Y) (hf : function.injective f) (n : ℕ)
  : function.injective (((singular_chain_complex R).map f).f n) :=
begin
  refine map_domain_inj_of_inj _ _,
  intros σ τ hστ, dsimp at hστ,
  ext p,
  have := congr_arg (λ g : topological_simplex n → Y, g p)
                    (congr_arg continuous_map.to_fun hστ),
  exact hf this
end

noncomputable
instance singular_chain_complex_preserves_coprod (R : Type*) [comm_ring R] {J : Type} (f : J → Top)
  : limits.preserves_colimit (discrete.functor f) (singular_chain_complex R) :=
begin
  apply_with limits.comp_preserves_colimit {instances:=ff},
  { apply Top.to_sSet'_preserves_coprod },
  { apply_with limits.comp_preserves_colimit {instances:=ff},
    { apply_with limits.preserves_colimits_of_shape.preserves_colimit {instances:=ff},
      apply_with category_theory.whiskering_right_preserves_colimits_of_shape {instances:=ff},
      apply_instance,
      apply (Module.adj R).left_adjoint_preserves_colimits.preserves_colimits_of_shape },
    { apply category_theory.limits.preserves_colimits_of_size.preserves_colimits_of_shape.preserves_colimit,
      apply alternating_face_map_complex.preserves_colimits } }
end

noncomputable
instance singular_homology_preserves_coprod (R : Type*) [comm_ring R] (n : ℕ) {J : Type} (f : J → Top)
  : limits.preserves_colimit (discrete.functor f) (singular_homology R n) :=
begin
  apply_with limits.comp_preserves_colimit {instances:=ff},
  { apply_instance },
  { let := @category_theory.homology_functor_preserves_coproducts (Module R) (Module.Module_category R) ℕ
             (complex_shape.down ℕ) J _,
    letI := (λ (J : Type), limits.has_colimits_of_shape_of_has_colimits_of_size : limits.has_coproducts (Module R)),
    apply_instance}
end


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin, Scott Morrison

! This file was ported from Lean 3 source module analysis.convex.caratheodory
! leanprover-community/mathlib commit e6fab1dc073396d45da082c644642c4f8bff2264
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.Convex.Combination
import Mathbin.LinearAlgebra.AffineSpace.Independent
import Mathbin.Tactic.FieldSimp

/-!
# Carathéodory's convexity theorem

Convex hull can be regarded as a refinement of affine span. Both are closure operators but whereas
convex hull takes values in the lattice of convex subsets, affine span takes values in the much
coarser sublattice of affine subspaces.

The cost of this refinement is that one no longer has bases. However Carathéodory's convexity
theorem offers some compensation. Given a set `s` together with a point `x` in its convex hull,
Carathéodory says that one may find an affine-independent family of elements `s` whose convex hull
contains `x`. Thus the difference from the case of affine span is that the affine-independent family
depends on `x`.

In particular, in finite dimensions Carathéodory's theorem implies that the convex hull of a set `s`
in `𝕜ᵈ` is the union of the convex hulls of the `(d + 1)`-tuples in `s`.

## Main results

* `convex_hull_eq_union`: Carathéodory's convexity theorem

## Implementation details

This theorem was formalized as part of the Sphere Eversion project.

## Tags
convex hull, caratheodory

-/

open Set Finset

open BigOperators

universe u

variable {𝕜 : Type _} {E : Type u} [LinearOrderedField 𝕜] [AddCommGroup E] [Module 𝕜 E]

namespace Caratheodory

/-- If `x` is in the convex hull of some finset `t` whose elements are not affine-independent,
then it is in the convex hull of a strict subset of `t`. -/
theorem mem_convexHull_erase [DecidableEq E] {t : Finset E} (h : ¬AffineIndependent 𝕜 (coe : t → E))
    {x : E} (m : x ∈ convexHull 𝕜 (↑t : Set E)) :
    ∃ y : (↑t : Set E), x ∈ convexHull 𝕜 (↑(t.eraseₓ y) : Set E) :=
  by
  simp only [Finset.convexHull_eq, mem_set_of_eq] at m⊢
  obtain ⟨f, fpos, fsum, rfl⟩ := m
  obtain ⟨g, gcombo, gsum, gpos⟩ := exists_nontrivial_relation_sum_zero_of_not_affine_ind h
  replace gpos := exists_pos_of_sum_zero_of_exists_nonzero g gsum gpos
  clear h
  let s := @Finset.filter _ (fun z => 0 < g z) (fun _ => LinearOrder.decidableLt _ _) t
  obtain ⟨i₀, mem, w⟩ : ∃ i₀ ∈ s, ∀ i ∈ s, f i₀ / g i₀ ≤ f i / g i :=
    by
    apply s.exists_min_image fun z => f z / g z
    obtain ⟨x, hx, hgx⟩ : ∃ x ∈ t, 0 < g x := gpos
    exact ⟨x, mem_filter.mpr ⟨hx, hgx⟩⟩
  have hg : 0 < g i₀ := by
    rw [mem_filter] at mem
    exact mem.2
  have hi₀ : i₀ ∈ t := filter_subset _ _ mem
  let k : E → 𝕜 := fun z => f z - f i₀ / g i₀ * g z
  have hk : k i₀ = 0 := by field_simp [k, ne_of_gt hg]
  have ksum : (∑ e in t.erase i₀, k e) = 1 := by
    calc
      (∑ e in t.erase i₀, k e) = ∑ e in t, k e := by
        conv_rhs => rw [← insert_erase hi₀, sum_insert (not_mem_erase i₀ t), hk, zero_add]
      _ = ∑ e in t, f e - f i₀ / g i₀ * g e := rfl
      _ = 1 := by rw [sum_sub_distrib, fsum, ← mul_sum, gsum, MulZeroClass.mul_zero, sub_zero]

  refine' ⟨⟨i₀, hi₀⟩, k, _, by convert ksum, _⟩
  · simp only [and_imp, sub_nonneg, mem_erase, Ne.def, Subtype.coe_mk]
    intro e hei₀ het
    by_cases hes : e ∈ s
    · have hge : 0 < g e := by
        rw [mem_filter] at hes
        exact hes.2
      rw [← le_div_iff hge]
      exact w _ hes
    · calc
        _ ≤ 0 := mul_nonpos_of_nonneg_of_nonpos _ _
        -- prove two goals below
            _ ≤
            f e :=
          fpos e het

      · apply div_nonneg (fpos i₀ (mem_of_subset (filter_subset _ t) mem)) (le_of_lt hg)
      · simpa only [mem_filter, het, true_and_iff, not_lt] using hes
  · simp only [Subtype.coe_mk, center_mass_eq_of_sum_1 _ id ksum, id]
    calc
      (∑ e in t.erase i₀, k e • e) = ∑ e in t, k e • e := sum_erase _ (by rw [hk, zero_smul])
      _ = ∑ e in t, (f e - f i₀ / g i₀ * g e) • e := rfl
      _ = t.center_mass f id := _

    simp only [sub_smul, mul_smul, sum_sub_distrib, ← smul_sum, gcombo, smul_zero, sub_zero,
      center_mass, fsum, inv_one, one_smul, id.def]
#align caratheodory.mem_convex_hull_erase Caratheodory.mem_convexHull_erase

variable {s : Set E} {x : E} (hx : x ∈ convexHull 𝕜 s)

include hx

/-- Given a point `x` in the convex hull of a set `s`, this is a finite subset of `s` of minimum
cardinality, whose convex hull contains `x`. -/
noncomputable def minCardFinsetOfMemConvexHull : Finset E :=
  Function.argminOn Finset.card Nat.lt_wfRel { t | ↑t ⊆ s ∧ x ∈ convexHull 𝕜 (t : Set E) }
    (by
      simpa only [convexHull_eq_union_convexHull_finite_subsets s, exists_prop, mem_Union] using hx)
#align caratheodory.min_card_finset_of_mem_convex_hull Caratheodory.minCardFinsetOfMemConvexHull

theorem minCardFinsetOfMemConvexHull_subseteq : ↑(minCardFinsetOfMemConvexHull hx) ⊆ s :=
  (Function.argminOn_mem _ _ { t : Finset E | ↑t ⊆ s ∧ x ∈ convexHull 𝕜 (t : Set E) } _).1
#align caratheodory.min_card_finset_of_mem_convex_hull_subseteq Caratheodory.minCardFinsetOfMemConvexHull_subseteq

theorem mem_minCardFinsetOfMemConvexHull :
    x ∈ convexHull 𝕜 (minCardFinsetOfMemConvexHull hx : Set E) :=
  (Function.argminOn_mem _ _ { t : Finset E | ↑t ⊆ s ∧ x ∈ convexHull 𝕜 (t : Set E) } _).2
#align caratheodory.mem_min_card_finset_of_mem_convex_hull Caratheodory.mem_minCardFinsetOfMemConvexHull

theorem minCardFinsetOfMemConvexHull_nonempty : (minCardFinsetOfMemConvexHull hx).Nonempty :=
  by
  rw [← Finset.coe_nonempty, ← @convexHull_nonempty_iff 𝕜]
  exact ⟨x, mem_min_card_finset_of_mem_convex_hull hx⟩
#align caratheodory.min_card_finset_of_mem_convex_hull_nonempty Caratheodory.minCardFinsetOfMemConvexHull_nonempty

theorem minCardFinsetOfMemConvexHull_card_le_card {t : Finset E} (ht₁ : ↑t ⊆ s)
    (ht₂ : x ∈ convexHull 𝕜 (t : Set E)) : (minCardFinsetOfMemConvexHull hx).card ≤ t.card :=
  Function.argminOn_le _ _ _ ⟨ht₁, ht₂⟩
#align caratheodory.min_card_finset_of_mem_convex_hull_card_le_card Caratheodory.minCardFinsetOfMemConvexHull_card_le_card

theorem affineIndependent_minCardFinsetOfMemConvexHull :
    AffineIndependent 𝕜 (coe : minCardFinsetOfMemConvexHull hx → E) :=
  by
  let k := (min_card_finset_of_mem_convex_hull hx).card - 1
  have hk : (min_card_finset_of_mem_convex_hull hx).card = k + 1 :=
    (Nat.succ_pred_eq_of_pos
        (finset.card_pos.mpr (min_card_finset_of_mem_convex_hull_nonempty hx))).symm
  classical
    by_contra
    obtain ⟨p, hp⟩ := mem_convex_hull_erase h (mem_min_card_finset_of_mem_convex_hull hx)
    have contra :=
      min_card_finset_of_mem_convex_hull_card_le_card hx
        (Set.Subset.trans (Finset.erase_subset (↑p) (min_card_finset_of_mem_convex_hull hx))
          (min_card_finset_of_mem_convex_hull_subseteq hx))
        hp
    rw [← not_lt] at contra
    apply contra
    erw [card_erase_of_mem p.2, hk]
    exact lt_add_one _
#align caratheodory.affine_independent_min_card_finset_of_mem_convex_hull Caratheodory.affineIndependent_minCardFinsetOfMemConvexHull

end Caratheodory

variable {s : Set E}

/-- **Carathéodory's convexity theorem** -/
theorem convexHull_eq_union :
    convexHull 𝕜 s =
      ⋃ (t : Finset E) (hss : ↑t ⊆ s) (hai : AffineIndependent 𝕜 (coe : t → E)), convexHull 𝕜 ↑t :=
  by
  apply Set.Subset.antisymm
  · intro x hx
    simp only [exists_prop, Set.mem_unionᵢ]
    exact
      ⟨Caratheodory.minCardFinsetOfMemConvexHull hx,
        Caratheodory.minCardFinsetOfMemConvexHull_subseteq hx,
        Caratheodory.affineIndependent_minCardFinsetOfMemConvexHull hx,
        Caratheodory.mem_minCardFinsetOfMemConvexHull hx⟩
  · iterate 3 convert Set.unionᵢ_subset _; intro
    exact convexHull_mono ‹_›
#align convex_hull_eq_union convexHull_eq_union

/-- A more explicit version of `convex_hull_eq_union`. -/
theorem eq_pos_convex_span_of_mem_convexHull {x : E} (hx : x ∈ convexHull 𝕜 s) :
    ∃ (ι : Sort (u + 1))(_ : Fintype ι),
      ∃ (z : ι → E)(w : ι → 𝕜)(hss : Set.range z ⊆ s)(hai : AffineIndependent 𝕜 z)(hw :
        ∀ i, 0 < w i), (∑ i, w i) = 1 ∧ (∑ i, w i • z i) = x :=
  by
  rw [convexHull_eq_union] at hx
  simp only [exists_prop, Set.mem_unionᵢ] at hx
  obtain ⟨t, ht₁, ht₂, ht₃⟩ := hx
  simp only [t.convex_hull_eq, exists_prop, Set.mem_setOf_eq] at ht₃
  obtain ⟨w, hw₁, hw₂, hw₃⟩ := ht₃
  let t' := t.filter fun i => w i ≠ 0
  refine' ⟨t', t'.fintype_coe_sort, (coe : t' → E), w ∘ (coe : t' → E), _, _, _, _, _⟩
  · rw [Subtype.range_coe_subtype]
    exact subset.trans (Finset.filter_subset _ t) ht₁
  · exact ht₂.comp_embedding ⟨_, inclusion_injective (Finset.filter_subset (fun i => w i ≠ 0) t)⟩
  ·
    exact fun i =>
      (hw₁ _ (finset.mem_filter.mp i.2).1).lt_of_ne (finset.mem_filter.mp i.property).2.symm
  · erw [Finset.sum_attach, Finset.sum_filter_ne_zero, hw₂]
  · change (∑ i : t' in t'.attach, (fun e => w e • e) ↑i) = x
    erw [Finset.sum_attach, Finset.sum_filter_of_ne]
    · rw [t.center_mass_eq_of_sum_1 id hw₂] at hw₃
      exact hw₃
    · intro e he hwe contra
      apply hwe
      rw [contra, zero_smul]
#align eq_pos_convex_span_of_mem_convex_hull eq_pos_convex_span_of_mem_convexHull


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

import group_theory.complement
import group_theory.group_action.basic
import group_theory.sylow

/-!
# The Schur-Zassenhaus Theorem

In this file we prove the Schur-Zassenhaus theorem.

## Main results

- `exists_right_complement'_of_coprime` : The **Schur-Zassenhaus** theorem:
  If `H : subgroup G` is normal and has order coprime to its index,
  then there exists a subgroup `K` which is a (right) complement of `H`.
- `exists_left_complement'_of_coprime`  The **Schur-Zassenhaus** theorem:
  If `H : subgroup G` is normal and has order coprime to its index,
  then there exists a subgroup `K` which is a (left) complement of `H`.
-/

open_locale big_operators

namespace subgroup

section schur_zassenhaus_abelian

variables {G : Type*} [group G] {H : subgroup G}

@[to_additive] instance : mul_action G (left_transversals (H : set G)) :=
{ smul := λ g T, ⟨left_coset g T, mem_left_transversals_iff_exists_unique_inv_mul_mem.mpr (λ g', by
  { obtain ⟨t, ht1, ht2⟩ := mem_left_transversals_iff_exists_unique_inv_mul_mem.mp T.2 (g⁻¹ * g'),
    simp_rw [←mul_assoc, ←mul_inv_rev] at ht1 ht2,
    refine ⟨⟨g * t, mem_left_coset g t.2⟩, ht1, _⟩,
    rintros ⟨_, t', ht', rfl⟩ h,
    exact subtype.ext ((mul_right_inj g).mpr (subtype.ext_iff.mp (ht2 ⟨t', ht'⟩ h))) })⟩,
  one_smul := λ T, subtype.ext (one_left_coset T),
  mul_smul := λ g g' T, subtype.ext (left_coset_assoc ↑T g g').symm }

lemma smul_symm_apply_eq_mul_symm_apply_inv_smul
  (g : G) (α : left_transversals (H : set G)) (q : G ⧸ H) :
  ↑((equiv.of_bijective _ (mem_left_transversals_iff_bijective.mp (g • α).2)).symm q) =
    g * ((equiv.of_bijective _ (mem_left_transversals_iff_bijective.mp α.2)).symm
      (g⁻¹ • q : G ⧸ H)) :=
begin
  let w := (equiv.of_bijective _ (mem_left_transversals_iff_bijective.mp α.2)),
  let y := (equiv.of_bijective _ (mem_left_transversals_iff_bijective.mp (g • α).2)),
  change ↑(y.symm q) = ↑(⟨_, mem_left_coset g (subtype.mem _)⟩ : (g • α).1),
  refine subtype.ext_iff.mp (y.symm_apply_eq.mpr _),
  change q = g • (w (w.symm (g⁻¹ • q : G ⧸ H))),
  rw [equiv.apply_symm_apply, ←mul_smul, mul_inv_self, one_smul],
end

variables [is_commutative H] [fintype (G ⧸ H)]

variables (α β γ : left_transversals (H : set G))

/-- The difference of two left transversals -/
@[to_additive "The difference of two left transversals"]
noncomputable def diff [hH : normal H] : H :=
let α' := (equiv.of_bijective _ (mem_left_transversals_iff_bijective.mp α.2)).symm,
    β' := (equiv.of_bijective _ (mem_left_transversals_iff_bijective.mp β.2)).symm in
∏ (q : G ⧸ H), ⟨(α' q) * (β' q)⁻¹,
  hH.mem_comm (quotient.exact' ((β'.symm_apply_apply q).trans (α'.symm_apply_apply q).symm))⟩

@[to_additive] lemma diff_mul_diff [normal H] : diff α β * diff β γ = diff α γ :=
finset.prod_mul_distrib.symm.trans (finset.prod_congr rfl (λ x hx, subtype.ext
  (by rw [coe_mul, coe_mk, coe_mk, coe_mk, mul_assoc, inv_mul_cancel_left])))

@[to_additive] lemma diff_self [normal H] : diff α α = 1 :=
mul_right_eq_self.mp (diff_mul_diff α α α)

@[to_additive] lemma diff_inv [normal H]: (diff α β)⁻¹ = diff β α :=
inv_eq_of_mul_eq_one ((diff_mul_diff α β α).trans (diff_self α))

lemma smul_diff_smul [hH : normal H] (g : G) :
  diff (g • α) (g • β) = ⟨g * diff α β * g⁻¹, hH.conj_mem (diff α β).1 (diff α β).2 g⟩ :=
begin
  let ϕ : H →* H :=
  { to_fun := λ h, ⟨g * h * g⁻¹, hH.conj_mem h.1 h.2 g⟩,
    map_one' := subtype.ext (by rw [coe_mk, coe_one, mul_one, mul_inv_self]),
    map_mul' := λ h₁ h₂, subtype.ext (by rw [coe_mk, coe_mul, coe_mul, coe_mk, coe_mk, mul_assoc,
      mul_assoc, mul_assoc, mul_assoc, mul_assoc, inv_mul_cancel_left]) },
  refine eq.trans (finset.prod_bij' (λ q _, (↑g)⁻¹ * q) (λ _ _, finset.mem_univ _)
    (λ q _, subtype.ext _) (λ q _, ↑g * q) (λ _ _, finset.mem_univ _)
    (λ q _, mul_inv_cancel_left g q) (λ q _, inv_mul_cancel_left g q)) (ϕ.map_prod _ _).symm,
  change _ * _ = g * (_ * _) * g⁻¹,
  simp_rw [smul_symm_apply_eq_mul_symm_apply_inv_smul, mul_inv_rev, mul_assoc],
  refl,
end

lemma smul_diff [H.normal] (h : H) :
  diff (h • α) β = h ^ H.index * diff α β :=
begin
  rw [diff, diff, index_eq_card, ←finset.card_univ, ←finset.prod_const, ←finset.prod_mul_distrib],
  refine finset.prod_congr rfl (λ q _, _),
  rw [subtype.ext_iff, coe_mul, coe_mk, coe_mk, ←mul_assoc, mul_right_cancel_iff],
  rw [show h • α = (h : G) • α, from rfl, smul_symm_apply_eq_mul_symm_apply_inv_smul],
  rw [mul_left_cancel_iff, ←subtype.ext_iff, equiv.apply_eq_iff_eq, inv_smul_eq_iff],
  exact self_eq_mul_left.mpr ((quotient_group.eq_one_iff _).mpr h.2),
end

variables (H)

instance setoid_diff [H.normal] : setoid (left_transversals (H : set G)) :=
setoid.mk (λ α β, diff α β = 1) ⟨λ α, diff_self α, λ α β h₁,
  by rw [←diff_inv, h₁, one_inv], λ α β γ h₁ h₂, by rw [←diff_mul_diff, h₁, h₂, one_mul]⟩

/-- The quotient of the transversals of an abelian normal `N` by the `diff` relation -/
def quotient_diff [H.normal] :=
quotient H.setoid_diff

instance [H.normal] : inhabited H.quotient_diff :=
quotient.inhabited

variables {H}

instance [H.normal] : mul_action G H.quotient_diff :=
{ smul := λ g, quotient.map (λ α, g • α) (λ α β h, (smul_diff_smul α β g).trans
    (subtype.ext (mul_inv_eq_one.mpr (mul_right_eq_self.mpr (subtype.ext_iff.mp h))))),
  mul_smul := λ g₁ g₂ q, quotient.induction_on q (λ α, congr_arg quotient.mk (mul_smul g₁ g₂ α)),
  one_smul := λ q, quotient.induction_on q (λ α, congr_arg quotient.mk (one_smul G α)) }

variables [fintype H]

lemma exists_smul_eq [H.normal] (α β : H.quotient_diff)
  (hH : nat.coprime (fintype.card H) H.index) :
  ∃ h : H, h • α = β :=
quotient.induction_on α (quotient.induction_on β
  (λ β α, exists_imp_exists (λ n, quotient.sound)
    ⟨(pow_coprime hH).symm (diff α β)⁻¹, by
    { change diff ((_ : H) • _) _ = 1,
      rw smul_diff,
      change pow_coprime hH ((pow_coprime hH).symm (diff α β)⁻¹) * (diff α β) = 1,
      rw [equiv.apply_symm_apply, inv_mul_self] }⟩))

lemma smul_left_injective [H.normal] (α : H.quotient_diff)
  (hH : nat.coprime (fintype.card H) H.index) :
  function.injective (λ h : H, h • α) :=
λ h₁ h₂, begin
  refine quotient.induction_on α (λ α hα, _),
  replace hα : diff (h₁ • α) (h₂ • α) = 1 := quotient.exact hα,
  rw [smul_diff, ←diff_inv, smul_diff, diff_self, mul_one, mul_inv_eq_one] at hα,
  exact (pow_coprime hH).injective hα,
end

lemma is_complement'_stabilizer_of_coprime [fintype G] [H.normal] {α : H.quotient_diff}
  (hH : nat.coprime (fintype.card H) H.index) :
  is_complement' H (mul_action.stabilizer G α) :=
begin
  classical,
  let ϕ : H ≃ mul_action.orbit G α := equiv.of_bijective (λ h, ⟨h • α, h, rfl⟩)
    ⟨λ h₁ h₂ hh, smul_left_injective α hH (subtype.ext_iff.mp hh),
      λ β, exists_imp_exists (λ h hh, subtype.ext hh) (exists_smul_eq α β hH)⟩,
  have key := card_eq_card_quotient_mul_card_subgroup (mul_action.stabilizer G α),
  rw ← fintype.card_congr (ϕ.trans (mul_action.orbit_equiv_quotient_stabilizer G α)) at key,
  apply is_complement'_of_coprime key.symm,
  rw [card_eq_card_quotient_mul_card_subgroup H, mul_comm, mul_right_inj'] at key,
  { rwa [←key, ←index_eq_card] },
  { rw [←pos_iff_ne_zero, fintype.card_pos_iff],
    apply_instance },
end

/-- Do not use this lemma: It is made obsolete by `exists_right_complement'_of_coprime` -/
private lemma exists_right_complement'_of_coprime_aux [fintype G] [H.normal]
  (hH : nat.coprime (fintype.card H) H.index) :
  ∃ K : subgroup G, is_complement' H K :=
nonempty_of_inhabited.elim
  (λ α : H.quotient_diff, ⟨mul_action.stabilizer G α, is_complement'_stabilizer_of_coprime hH⟩)

end schur_zassenhaus_abelian

open_locale classical

universe u

namespace schur_zassenhaus_induction

/-! ## Proof of the Schur-Zassenhaus theorem

In this section, we prove the Schur-Zassenhaus theorem.
The proof is by contradiction. We assume that `G` is a minimal counterexample to the theorem.
-/

variables {G : Type u} [group G] [fintype G] {N : subgroup G} [normal N]
  (h1 : nat.coprime (fintype.card N) N.index)
  (h2 : ∀ (G' : Type u) [group G'] [fintype G'], by exactI
    ∀ (hG'3 : fintype.card G' < fintype.card G)
    {N' : subgroup G'} [N'.normal] (hN : nat.coprime (fintype.card N') N'.index),
    ∃ H' : subgroup G', is_complement' N' H')
  (h3 : ∀ H : subgroup G, ¬ is_complement' N H)

include h1 h2 h3

/-! We will arrive at a contradiction via the following steps:
 * step 0: `N` (the normal Hall subgroup) is nontrivial.
 * step 1: If `K` is a subgroup of `G` with `K ⊔ N = ⊤`, then `K = ⊤`.
 * step 2: `N` is a minimal normal subgroup, phrased in terms of subgroups of `G`.
 * step 3: `N` is a minimal normal subgroup, phrased in terms of subgroups of `N`.
 * step 4: `p` (`min_fact (fintype.card N)`) is prime (follows from step0).
 * step 5: `P` (a Sylow `p`-subgroup of `N`) is nontrivial.
 * step 6: `N` is a `p`-group (applies step 1 to the normalizer of `P` in `G`).
 * step 7: `N` is abelian (applies step 3 to the center of `N`).
-/

/-- Do not use this lemma: It is made obsolete by `exists_right_complement'_of_coprime` -/
@[nolint unused_arguments] private lemma step0 : N ≠ ⊥ :=
begin
  unfreezingI { rintro rfl },
  exact h3 ⊤ is_complement'_bot_top,
end

/-- Do not use this lemma: It is made obsolete by `exists_right_complement'_of_coprime` -/
private lemma step1 (K : subgroup G) (hK : K ⊔ N = ⊤) : K = ⊤ :=
begin
  contrapose! h3,
  have h4 : (N.comap K.subtype).index = N.index,
  { rw [←N.relindex_top_right, ←hK],
    exact relindex_eq_relindex_sup K N },
  have h5 : fintype.card K < fintype.card G,
  { rw ← K.index_mul_card,
    exact lt_mul_of_one_lt_left fintype.card_pos (one_lt_index_of_ne_top h3) },
  have h6 : nat.coprime (fintype.card (N.comap K.subtype)) (N.comap K.subtype).index,
  { rw h4,
    exact h1.coprime_dvd_left (card_comap_dvd_of_injective N K.subtype subtype.coe_injective) },
  obtain ⟨H, hH⟩ := h2 K h5 h6,
  replace hH : fintype.card (H.map K.subtype) = N.index :=
  ((set.card_image_of_injective _ subtype.coe_injective).trans (nat.mul_left_injective
    fintype.card_pos (hH.symm.card_mul.trans (N.comap K.subtype).index_mul_card.symm))).trans h4,
  have h7 : fintype.card N * fintype.card (H.map K.subtype) = fintype.card G,
  { rw [hH, ←N.index_mul_card, mul_comm] },
  have h8 : (fintype.card N).coprime (fintype.card (H.map K.subtype)),
  { rwa hH },
  exact ⟨H.map K.subtype, is_complement'_of_coprime h7 h8⟩,
end

/-- Do not use this lemma: It is made obsolete by `exists_right_complement'_of_coprime` -/
private lemma step2 (K : subgroup G) [K.normal] (hK : K ≤ N) : K = ⊥ ∨ K = N :=
begin
  have : function.surjective (quotient_group.mk' K) := quotient.surjective_quotient_mk',
  have h4 := step1 h1 h2 h3,
  contrapose! h4,
  have h5 : fintype.card (G ⧸ K) < fintype.card G,
  { rw [←index_eq_card, ←K.index_mul_card],
    refine lt_mul_of_one_lt_right (nat.pos_of_ne_zero index_ne_zero_of_fintype)
      (K.one_lt_card_iff_ne_bot.mpr h4.1) },
  have h6 : nat.coprime (fintype.card (N.map (quotient_group.mk' K)))
    (N.map (quotient_group.mk' K)).index,
  { have index_map := N.index_map_eq this (by rwa quotient_group.ker_mk),
    have index_pos : 0 < N.index := nat.pos_of_ne_zero index_ne_zero_of_fintype,
    rw index_map,
    refine h1.coprime_dvd_left _,
    rw [←nat.mul_dvd_mul_iff_left index_pos, index_mul_card, ←index_map, index_mul_card],
    exact K.card_quotient_dvd_card },
  obtain ⟨H, hH⟩ := h2 (G ⧸ K) h5 h6,
  refine ⟨H.comap (quotient_group.mk' K), _, _⟩,
  { have key : (N.map (quotient_group.mk' K)).comap (quotient_group.mk' K) = N,
    { refine comap_map_eq_self _,
      rwa quotient_group.ker_mk },
    rwa [←key, comap_sup_eq, hH.symm.sup_eq_top, comap_top] },
  { rw ← comap_top (quotient_group.mk' K),
    intro hH',
    rw [comap_injective this hH', is_complement'_top_right,
        map_eq_bot_iff, quotient_group.ker_mk] at hH,
    { exact h4.2 (le_antisymm hK hH) } },
end

/-- Do not use this lemma: It is made obsolete by `exists_right_complement'_of_coprime` -/
private lemma step3 (K : subgroup N) [(K.map N.subtype).normal] : K = ⊥ ∨ K = ⊤ :=
begin
  have key := step2 h1 h2 h3 (K.map N.subtype) K.map_subtype_le,
  rw ← map_bot N.subtype at key,
  conv at key { congr, skip, to_rhs, rw [←N.subtype_range, N.subtype.range_eq_map] },
  have inj := map_injective (show function.injective N.subtype, from subtype.coe_injective),
  rwa [inj.eq_iff, inj.eq_iff] at key,
end

/-- Do not use this lemma: It is made obsolete by `exists_right_complement'_of_coprime` -/
private lemma step4 : (fintype.card N).min_fac.prime :=
(nat.min_fac_prime (N.one_lt_card_iff_ne_bot.mpr (step0 h1 h2 h3)).ne')

/-- Do not use this lemma: It is made obsolete by `exists_right_complement'_of_coprime` -/
private lemma step5 {P : sylow (fintype.card N).min_fac N} : P.1 ≠ ⊥ :=
begin
  haveI : fact ((fintype.card N).min_fac.prime) := ⟨step4 h1 h2 h3⟩,
  exact P.ne_bot_of_dvd_card (fintype.card N).min_fac_dvd,
end

/-- Do not use this lemma: It is made obsolete by `exists_right_complement'_of_coprime` -/
private lemma step6 : is_p_group (fintype.card N).min_fac N :=
begin
  haveI : fact ((fintype.card N).min_fac.prime) := ⟨step4 h1 h2 h3⟩,
  refine sylow.nonempty.elim (λ P, P.2.of_surjective P.1.subtype _),
  rw [←monoid_hom.range_top_iff_surjective, subtype_range],
  haveI : (P.1.map N.subtype).normal := normalizer_eq_top.mp
    (step1 h1 h2 h3 (P.1.map N.subtype).normalizer P.normalizer_sup_eq_top),
  exact (step3 h1 h2 h3 P.1).resolve_left (step5 h1 h2 h3),
end

/-- Do not use this lemma: It is made obsolete by `exists_right_complement'_of_coprime` -/
lemma step7 : is_commutative N :=
begin
  haveI := N.bot_or_nontrivial.resolve_left (step0 h1 h2 h3),
  haveI : fact ((fintype.card N).min_fac.prime) := ⟨step4 h1 h2 h3⟩,
  exact ⟨⟨λ g h, eq_top_iff.mp ((step3 h1 h2 h3 N.center).resolve_left
    (step6 h1 h2 h3).bot_lt_center.ne') (mem_top h) g⟩⟩,
end

end schur_zassenhaus_induction

variables {n : ℕ} {G : Type u} [group G]

/-- Do not use this lemma: It is made obsolete by `exists_right_complement'_of_coprime` -/
private lemma exists_right_complement'_of_coprime_aux' [fintype G] (hG : fintype.card G = n)
  {N : subgroup G} [N.normal] (hN : nat.coprime (fintype.card N) N.index) :
  ∃ H : subgroup G, is_complement' N H :=
begin
  unfreezingI { revert G },
  apply nat.strong_induction_on n,
  rintros n ih G _ _ rfl N _ hN,
  refine not_forall_not.mp (λ h3, _),
  haveI := by exactI
    schur_zassenhaus_induction.step7 hN (λ G' _ _ hG', by { apply ih _ hG', refl }) h3,
  exact not_exists_of_forall_not h3 (exists_right_complement'_of_coprime_aux hN),
end

/-- **Schur-Zassenhaus** for normal subgroups:
  If `H : subgroup G` is normal, and has order coprime to its index, then there exists a
  subgroup `K` which is a (right) complement of `H`. -/

/-- **Schur-Zassenhaus** for normal subgroups:
  If `H : subgroup G` is normal, and has order coprime to its index, then there exists a
  subgroup `K` which is a (right) complement of `H`. -/
theorem exists_right_complement'_of_coprime
  {N : subgroup G} [N.normal] (hN : nat.coprime (nat.card N) N.index) :
  ∃ H : subgroup G, is_complement' N H :=
begin
  by_cases hN1 : nat.card N = 0,
  { rw [hN1, nat.coprime_zero_left, index_eq_one] at hN,
    rw hN,
    exact ⟨⊥, is_complement'_top_bot⟩ },
  by_cases hN2 : N.index = 0,
  { rw [hN2, nat.coprime_zero_right] at hN,
    haveI := (cardinal.to_nat_eq_one_iff_unique.mp hN).1,
    rw N.eq_bot_of_subsingleton,
    exact ⟨⊤, is_complement'_bot_top⟩ },
  have hN3 : nat.card G ≠ 0,
  { rw ← N.card_mul_index,
    exact mul_ne_zero hN1 hN2 },
  haveI := (cardinal.lt_omega_iff_fintype.mp
    (lt_of_not_ge (mt cardinal.to_nat_apply_of_omega_le hN3))).some,
  rw nat.card_eq_fintype_card at hN,
  exact exists_right_complement'_of_coprime_of_fintype hN,
end

/-- **Schur-Zassenhaus** for normal subgroups:
  If `H : subgroup G` is normal, and has order coprime to its index, then there exists a
  subgroup `K` which is a (left) complement of `H`. -/
theorem exists_left_complement'_of_coprime_of_fintype
  [fintype G] {N : subgroup G} [N.normal] (hN : nat.coprime (fintype.card N) N.index) :
  ∃ H : subgroup G, is_complement' H N :=
Exists.imp (λ _, is_complement'.symm) (exists_right_complement'_of_coprime_of_fintype hN)

/-- **Schur-Zassenhaus** for normal subgroups:
  If `H : subgroup G` is normal, and has order coprime to its index, then there exists a
  subgroup `K` which is a (left) complement of `H`. -/
theorem exists_left_complement'_of_coprime
  {N : subgroup G} [N.normal] (hN : nat.coprime (nat.card N) N.index) :
  ∃ H : subgroup G, is_complement' H N :=
Exists.imp (λ _, is_complement'.symm) (exists_right_complement'_of_coprime hN)

end subgroup


/-
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 ring_theory.mv_polynomial.basic

/-!
# Multivariate polynomials over fields

This file contains basic facts about multivariate polynomials over fields, for example that the
dimension of the space of multivariate polynomials over a field is equal to the cardinality of
finitely supported functions from the indexing set to `ℕ`.
-/

noncomputable theory

open_locale classical

open set linear_map submodule
open_locale big_operators

namespace mv_polynomial
universes u v
variables {σ : Type u} {K : Type v}
variables (σ K) [field K]

lemma quotient_mk_comp_C_injective (I : ideal (mv_polynomial σ K)) (hI : I ≠ ⊤) :
  function.injective ((ideal.quotient.mk I).comp mv_polynomial.C) :=
begin
  refine (ring_hom.injective_iff _).2 (λ x hx, _),
  rw [ring_hom.comp_apply, ideal.quotient.eq_zero_iff_mem] at hx,
  refine classical.by_contradiction (λ hx0, absurd (I.eq_top_iff_one.2 _) hI),
  have := I.mul_mem_left (mv_polynomial.C x⁻¹) hx,
  rwa [← mv_polynomial.C.map_mul, inv_mul_cancel hx0, mv_polynomial.C_1] at this,
end

end mv_polynomial

namespace mv_polynomial

universe u
variables {σ : Type u} {K : Type u} [field K]

open_locale classical

lemma dim_mv_polynomial : module.rank K (mv_polynomial σ K) = cardinal.mk (σ →₀ ℕ) :=
by rw [← cardinal.lift_inj, ← (basis_monomials σ K).mk_eq_dim]

end mv_polynomial


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

! This file was ported from Lean 3 source module measure_theory.group.action
! leanprover-community/mathlib commit f2ce6086713c78a7f880485f7917ea547a215982
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.MeasureTheory.Group.MeasurableEquiv
import Mathbin.MeasureTheory.Measure.Regular
import Mathbin.Dynamics.Ergodic.MeasurePreserving
import Mathbin.Dynamics.Minimal

/-!
# Measures invariant under group actions

A measure `μ : measure α` is said to be *invariant* under an action of a group `G` if scalar
multiplication by `c : G` is a measure preserving map for all `c`. In this file we define a
typeclass for measures invariant under action of an (additive or multiplicative) group and prove
some basic properties of such measures.
-/

open ENNReal NNReal Pointwise Topology

open MeasureTheory MeasureTheory.Measure Set Function

namespace MeasureTheory

variable {G M α : Type _} {s : Set α}

/- ./././Mathport/Syntax/Translate/Command.lean:388:30: infer kinds are unsupported in Lean 4: #[`measure_preimage_vadd] [] -/
/-- A measure `μ : measure α` is invariant under an additive action of `M` on `α` if for any
measurable set `s : set α` and `c : M`, the measure of its preimage under `λ x, c +ᵥ x` is equal to
the measure of `s`. -/
class VaddInvariantMeasure (M α : Type _) [VAdd M α] {_ : MeasurableSpace α} (μ : Measure α) :
  Prop where
  measure_preimage_vadd : ∀ (c : M) ⦃s : Set α⦄, MeasurableSet s → μ ((fun x => c +ᵥ x) ⁻¹' s) = μ s
#align measure_theory.vadd_invariant_measure MeasureTheory.VaddInvariantMeasure

/- ./././Mathport/Syntax/Translate/Command.lean:388:30: infer kinds are unsupported in Lean 4: #[`measure_preimage_smul] [] -/
/-- A measure `μ : measure α` is invariant under a multiplicative action of `M` on `α` if for any
measurable set `s : set α` and `c : M`, the measure of its preimage under `λ x, c • x` is equal to
the measure of `s`. -/
@[to_additive]
class SmulInvariantMeasure (M α : Type _) [SMul M α] {_ : MeasurableSpace α} (μ : Measure α) :
  Prop where
  measure_preimage_smul : ∀ (c : M) ⦃s : Set α⦄, MeasurableSet s → μ ((fun x => c • x) ⁻¹' s) = μ s
#align measure_theory.smul_invariant_measure MeasureTheory.SmulInvariantMeasure
#align measure_theory.vadd_invariant_measure MeasureTheory.VaddInvariantMeasure

namespace SmulInvariantMeasure

@[to_additive]
instance zero [MeasurableSpace α] [SMul M α] : SmulInvariantMeasure M α 0 :=
  ⟨fun _ _ _ => rfl⟩
#align measure_theory.smul_invariant_measure.zero MeasureTheory.SmulInvariantMeasure.zero
#align measure_theory.vadd_invariant_measure.zero MeasureTheory.VaddInvariantMeasure.zero

variable [SMul M α] {m : MeasurableSpace α} {μ ν : Measure α}

@[to_additive]
instance add [SmulInvariantMeasure M α μ] [SmulInvariantMeasure M α ν] :
    SmulInvariantMeasure M α (μ + ν) :=
  ⟨fun c s hs =>
    show _ + _ = _ + _ from
      congr_arg₂ (· + ·) (measure_preimage_smul μ c hs) (measure_preimage_smul ν c hs)⟩
#align measure_theory.smul_invariant_measure.add MeasureTheory.SmulInvariantMeasure.add
#align measure_theory.vadd_invariant_measure.add MeasureTheory.VaddInvariantMeasure.add

@[to_additive]
instance smul [SmulInvariantMeasure M α μ] (c : ℝ≥0∞) : SmulInvariantMeasure M α (c • μ) :=
  ⟨fun a s hs => show c • _ = c • _ from congr_arg ((· • ·) c) (measure_preimage_smul μ a hs)⟩
#align measure_theory.smul_invariant_measure.smul MeasureTheory.SmulInvariantMeasure.smul
#align measure_theory.vadd_invariant_measure.vadd MeasureTheory.VaddInvariantMeasure.vadd

@[to_additive]
instance smulNnreal [SmulInvariantMeasure M α μ] (c : ℝ≥0) : SmulInvariantMeasure M α (c • μ) :=
  SmulInvariantMeasure.smul c
#align measure_theory.smul_invariant_measure.smul_nnreal MeasureTheory.SmulInvariantMeasure.smulNnreal
#align measure_theory.vadd_invariant_measure.vadd_nnreal MeasureTheory.VaddInvariantMeasure.vadd_nnreal

end SmulInvariantMeasure

section HasMeasurableSmul

variable {m : MeasurableSpace α} [MeasurableSpace M] [SMul M α] [HasMeasurableSmul M α] (c : M)
  (μ : Measure α) [SmulInvariantMeasure M α μ]

@[simp, to_additive]
theorem measurePreservingSmul : MeasurePreserving ((· • ·) c) μ μ :=
  { Measurable := measurable_const_smul c
    map_eq := by
      ext1 s hs
      rw [map_apply (measurable_const_smul c) hs]
      exact smul_invariant_measure.measure_preimage_smul μ c hs }
#align measure_theory.measure_preserving_smul MeasureTheory.measurePreservingSmul
#align measure_theory.measure_preserving_vadd MeasureTheory.measure_preserving_vadd

@[simp, to_additive]
theorem map_smul : map ((· • ·) c) μ = μ :=
  (measurePreservingSmul c μ).map_eq
#align measure_theory.map_smul MeasureTheory.map_smul
#align measure_theory.map_vadd MeasureTheory.map_vadd

end HasMeasurableSmul

variable (G) {m : MeasurableSpace α} [Group G] [MulAction G α] [MeasurableSpace G]
  [HasMeasurableSmul G α] (c : G) (μ : Measure α)

/-- Equivalent definitions of a measure invariant under a multiplicative action of a group.

- 0: `smul_invariant_measure G α μ`;

- 1: for every `c : G` and a measurable set `s`, the measure of the preimage of `s` under scalar
     multiplication by `c` is equal to the measure of `s`;

- 2: for every `c : G` and a measurable set `s`, the measure of the image `c • s` of `s` under
     scalar multiplication by `c` is equal to the measure of `s`;

- 3, 4: properties 2, 3 for any set, including non-measurable ones;

- 5: for any `c : G`, scalar multiplication by `c` maps `μ` to `μ`;

- 6: for any `c : G`, scalar multiplication by `c` is a measure preserving map. -/
@[to_additive]
theorem smulInvariantMeasure_tFAE :
    TFAE
      [SmulInvariantMeasure G α μ, ∀ (c : G) (s), MeasurableSet s → μ ((· • ·) c ⁻¹' s) = μ s,
        ∀ (c : G) (s), MeasurableSet s → μ (c • s) = μ s, ∀ (c : G) (s), μ ((· • ·) c ⁻¹' s) = μ s,
        ∀ (c : G) (s), μ (c • s) = μ s, ∀ c : G, Measure.map ((· • ·) c) μ = μ,
        ∀ c : G, MeasurePreserving ((· • ·) c) μ μ] :=
  by
  tfae_have 1 ↔ 2; exact ⟨fun h => h.1, fun h => ⟨h⟩⟩
  tfae_have 1 → 6;
  · intro h c
    exact (measure_preserving_smul c μ).map_eq
  tfae_have 6 → 7; exact fun H c => ⟨measurable_const_smul c, H c⟩
  tfae_have 7 → 4; exact fun H c => (H c).measure_preimage_emb (measurableEmbedding_const_smul c)
  tfae_have 4 → 5;
  exact fun H c s => by
    rw [← preimage_smul_inv]
    apply H
  tfae_have 5 → 3; exact fun H c s hs => H c s
  tfae_have 3 → 2;
  · intro H c s hs
    rw [preimage_smul]
    exact H c⁻¹ s hs
  tfae_finish
#align measure_theory.smul_invariant_measure_tfae MeasureTheory.smulInvariantMeasure_tFAE
#align measure_theory.vadd_invariant_measure_tfae MeasureTheory.vadd_invariant_measure_tfae

/-- Equivalent definitions of a measure invariant under an additive action of a group.

- 0: `vadd_invariant_measure G α μ`;

- 1: for every `c : G` and a measurable set `s`, the measure of the preimage of `s` under
     vector addition `(+ᵥ) c` is equal to the measure of `s`;

- 2: for every `c : G` and a measurable set `s`, the measure of the image `c +ᵥ s` of `s` under
     vector addition `(+ᵥ) c` is equal to the measure of `s`;

- 3, 4: properties 2, 3 for any set, including non-measurable ones;

- 5: for any `c : G`, vector addition of `c` maps `μ` to `μ`;

- 6: for any `c : G`, vector addition of `c` is a measure preserving map. -/
add_decl_doc vadd_invariant_measure_tfae

variable {G} [SmulInvariantMeasure G α μ]

@[simp, to_additive]
theorem measure_preimage_smul (s : Set α) : μ ((· • ·) c ⁻¹' s) = μ s :=
  ((smulInvariantMeasure_tFAE G μ).out 0 3).mp ‹_› c s
#align measure_theory.measure_preimage_smul MeasureTheory.measure_preimage_smul
#align measure_theory.measure_preimage_vadd MeasureTheory.measure_preimage_vadd

@[simp, to_additive]
theorem measure_smul (s : Set α) : μ (c • s) = μ s :=
  ((smulInvariantMeasure_tFAE G μ).out 0 4).mp ‹_› c s
#align measure_theory.measure_smul MeasureTheory.measure_smul
#align measure_theory.measure_vadd MeasureTheory.measure_vadd

variable {μ}

@[to_additive]
theorem NullMeasurableSet.smul {s} (hs : NullMeasurableSet s μ) (c : G) :
    NullMeasurableSet (c • s) μ := by
  simpa only [← preimage_smul_inv] using
    hs.preimage (measure_preserving_smul _ _).QuasiMeasurePreserving
#align measure_theory.null_measurable_set.smul MeasureTheory.NullMeasurableSet.smul
#align measure_theory.null_measurable_set.vadd MeasureTheory.NullMeasurableSet.vadd

theorem measure_smul_null {s} (h : μ s = 0) (c : G) : μ (c • s) = 0 := by rwa [measure_smul]
#align measure_theory.measure_smul_null MeasureTheory.measure_smul_null

section IsMinimal

variable (G) [TopologicalSpace α] [ContinuousConstSMul G α] [MulAction.IsMinimal G α] {K U : Set α}

/-- If measure `μ` is invariant under a group action and is nonzero on a compact set `K`, then it is
positive on any nonempty open set. In case of a regular measure, one can assume `μ ≠ 0` instead of
`μ K ≠ 0`, see `measure_theory.measure_is_open_pos_of_smul_invariant_of_ne_zero`. -/
@[to_additive]
theorem measure_isOpen_pos_of_smul_invariant_of_compact_ne_zero (hK : IsCompact K) (hμK : μ K ≠ 0)
    (hU : IsOpen U) (hne : U.Nonempty) : 0 < μ U :=
  let ⟨t, ht⟩ := hK.exists_finite_cover_smul G hU hne
  pos_iff_ne_zero.2 fun hμU =>
    hμK <|
      measure_mono_null ht <|
        (measure_bUnion_null_iff t.countable_toSet).2 fun _ _ => by rwa [measure_smul]
#align measure_theory.measure_is_open_pos_of_smul_invariant_of_compact_ne_zero MeasureTheory.measure_isOpen_pos_of_smul_invariant_of_compact_ne_zero
#align measure_theory.measure_is_open_pos_of_vadd_invariant_of_compact_ne_zero MeasureTheory.measure_is_open_pos_of_vadd_invariant_of_compact_ne_zero

/-- If measure `μ` is invariant under an additive group action and is nonzero on a compact set `K`,
then it is positive on any nonempty open set. In case of a regular measure, one can assume `μ ≠ 0`
instead of `μ K ≠ 0`, see `measure_theory.measure_is_open_pos_of_vadd_invariant_of_ne_zero`. -/
add_decl_doc measure_is_open_pos_of_vadd_invariant_of_compact_ne_zero

@[to_additive]
theorem isLocallyFiniteMeasureOfSmulInvariant (hU : IsOpen U) (hne : U.Nonempty) (hμU : μ U ≠ ∞) :
    IsLocallyFiniteMeasure μ :=
  ⟨fun x =>
    let ⟨g, hg⟩ := hU.exists_smul_mem G x hne
    ⟨(· • ·) g ⁻¹' U, (hU.Preimage (continuous_id.const_smul _)).mem_nhds hg,
      Ne.lt_top <| by rwa [measure_preimage_smul]⟩⟩
#align measure_theory.is_locally_finite_measure_of_smul_invariant MeasureTheory.isLocallyFiniteMeasureOfSmulInvariant
#align measure_theory.is_locally_finite_measure_of_vadd_invariant MeasureTheory.is_locally_finite_measure_of_vadd_invariant

variable [Measure.Regular μ]

@[to_additive]
theorem measure_isOpen_pos_of_smul_invariant_of_ne_zero (hμ : μ ≠ 0) (hU : IsOpen U)
    (hne : U.Nonempty) : 0 < μ U :=
  let ⟨K, hK, hμK⟩ := Regular.exists_compact_not_null.mpr hμ
  measure_isOpen_pos_of_smul_invariant_of_compact_ne_zero G hK hμK hU hne
#align measure_theory.measure_is_open_pos_of_smul_invariant_of_ne_zero MeasureTheory.measure_isOpen_pos_of_smul_invariant_of_ne_zero
#align measure_theory.measure_is_open_pos_of_vadd_invariant_of_ne_zero MeasureTheory.measure_is_open_pos_of_vadd_invariant_of_ne_zero

@[to_additive]
theorem measure_pos_iff_nonempty_of_smul_invariant (hμ : μ ≠ 0) (hU : IsOpen U) :
    0 < μ U ↔ U.Nonempty :=
  ⟨fun h => nonempty_of_measure_ne_zero h.ne',
    measure_isOpen_pos_of_smul_invariant_of_ne_zero G hμ hU⟩
#align measure_theory.measure_pos_iff_nonempty_of_smul_invariant MeasureTheory.measure_pos_iff_nonempty_of_smul_invariant
#align measure_theory.measure_pos_iff_nonempty_of_vadd_invariant MeasureTheory.measure_pos_iff_nonempty_of_vadd_invariant

include G

@[to_additive]
theorem measure_eq_zero_iff_eq_empty_of_smul_invariant (hμ : μ ≠ 0) (hU : IsOpen U) :
    μ U = 0 ↔ U = ∅ := by
  rw [← not_iff_not, ← Ne.def, ← pos_iff_ne_zero,
    measure_pos_iff_nonempty_of_smul_invariant G hμ hU, nonempty_iff_ne_empty]
#align measure_theory.measure_eq_zero_iff_eq_empty_of_smul_invariant MeasureTheory.measure_eq_zero_iff_eq_empty_of_smul_invariant
#align measure_theory.measure_eq_zero_iff_eq_empty_of_vadd_invariant MeasureTheory.measure_eq_zero_iff_eq_empty_of_vadd_invariant

end IsMinimal

theorem smul_ae_eq_self_of_mem_zpowers {x y : G} (hs : (x • s : Set α) =ᵐ[μ] s)
    (hy : y ∈ Subgroup.zpowers x) : (y • s : Set α) =ᵐ[μ] s :=
  by
  obtain ⟨k, rfl⟩ := subgroup.mem_zpowers_iff.mp hy
  let e : α ≃ α := MulAction.toPermHom G α x
  have he : quasi_measure_preserving e μ μ := (measure_preserving_smul x μ).QuasiMeasurePreserving
  have he' : quasi_measure_preserving e.symm μ μ :=
    (measure_preserving_smul x⁻¹ μ).QuasiMeasurePreserving
  simpa only [MulAction.toPermHom_apply, MulAction.toPerm_apply, image_smul, ←
    MonoidHom.map_zpow] using he.image_zpow_ae_eq he' k hs
#align measure_theory.smul_ae_eq_self_of_mem_zpowers MeasureTheory.smul_ae_eq_self_of_mem_zpowers

theorem vadd_ae_eq_self_of_mem_zmultiples {G : Type _} [MeasurableSpace G] [AddGroup G]
    [AddAction G α] [VaddInvariantMeasure G α μ] [HasMeasurableVadd G α] {x y : G}
    (hs : (x +ᵥ s : Set α) =ᵐ[μ] s) (hy : y ∈ AddSubgroup.zmultiples x) :
    (y +ᵥ s : Set α) =ᵐ[μ] s :=
  by
  letI : MeasurableSpace (Multiplicative G) := (by infer_instance : MeasurableSpace G)
  letI : smul_invariant_measure (Multiplicative G) α μ :=
    ⟨fun g => vadd_invariant_measure.measure_preimage_vadd μ (Multiplicative.toAdd g)⟩
  letI : HasMeasurableSmul (Multiplicative G) α :=
    { measurable_const_smul := fun g => measurable_const_vadd (Multiplicative.toAdd g)
      measurable_smul_const := fun a =>
        @measurable_vadd_const (Multiplicative G) α (by infer_instance : VAdd G α) _ _
          (by infer_instance : HasMeasurableVadd G α) a }
  exact @smul_ae_eq_self_of_mem_zpowers (Multiplicative G) α _ _ _ _ _ _ _ _ _ _ hs hy
#align measure_theory.vadd_ae_eq_self_of_mem_zmultiples MeasureTheory.vadd_ae_eq_self_of_mem_zmultiples

attribute [to_additive vadd_ae_eq_self_of_mem_zmultiples] smul_ae_eq_self_of_mem_zpowers

end MeasureTheory


open Classical

theorem dne (p : Prop) (h : ¬¬p) : p :=
  Or.elim (em p)
  (fun (hp : p) => hp)
  (fun (hnp: ¬p) => absurd hnp h)

theorem step (p : Prop) (h : ¬(p ∨ ¬ p)) : ¬p :=
  fun (hp : p) => h (Or.intro_left (¬p) (hp))

theorem exclmid (p : Prop) : p ∨ ¬p :=
  dne (p ∨ ¬p) (
    fun (h : ¬(p ∨ ¬p)) =>
    h (Or.intro_right (p) (step p h))
  )