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

/-!
# Turning a preorder into a partial order

This file allows to make a preorder into a partial order by quotienting out the elements `a`, `b`
such that `a ≤ b` and `b ≤ a`.

`antisymmetrization` is a functor from `Preorder` to `PartialOrder`. See `Preorder_to_PartialOrder`.

## Main declarations

* `antisymm_rel`: The antisymmetrization relation. `antisymm_rel r a b` means that `a` and `b` are
  related both ways by `r`.
* `antisymmetrization α r`: The quotient of `α` by `antisymm_rel r`. Even when `r` is just a
  preorder, `antisymmetrization α` is a partial order.
-/

open function order_dual

variables {α β : Type*}

section relation
variables (r : α → α → Prop)

/-- The antisymmetrization relation. -/
def antisymm_rel (a b : α) : Prop := r a b ∧ r b a

lemma antisymm_rel_swap : antisymm_rel (swap r) = antisymm_rel r :=
funext $ λ _, funext $ λ _, propext and.comm

@[refl] lemma antisymm_rel_refl [is_refl α r] (a : α) : antisymm_rel r a a := ⟨refl _, refl _⟩

variables {r}

@[symm] lemma antisymm_rel.symm {a b : α} : antisymm_rel r a b → antisymm_rel r b a := and.symm

@[trans] lemma antisymm_rel.trans [is_trans α r] {a b c : α} (hab : antisymm_rel r a b)
  (hbc : antisymm_rel r b c) :
  antisymm_rel r a c :=
⟨trans hab.1 hbc.1, trans hbc.2 hab.2⟩

instance antisymm_rel.decidable_rel [decidable_rel r] : decidable_rel (antisymm_rel r) :=
λ _ _, and.decidable

@[simp] lemma antisymm_rel_iff_eq [is_refl α r] [is_antisymm α r] {a b : α} :
  antisymm_rel r a b ↔ a = b := antisymm_iff

alias antisymm_rel_iff_eq ↔ antisymm_rel.eq _

end relation

section is_preorder
variables (α) (r : α → α → Prop) [is_preorder α r]

/-- The antisymmetrization relation as an equivalence relation. -/
@[simps] def antisymm_rel.setoid : setoid α :=
⟨antisymm_rel r, antisymm_rel_refl _, λ _ _, antisymm_rel.symm, λ _ _ _, antisymm_rel.trans⟩

/-- The partial order derived from a preorder by making pairwise comparable elements equal. This is
the quotient by `λ a b, a ≤ b ∧ b ≤ a`. -/
def antisymmetrization : Type* := quotient $ antisymm_rel.setoid α r

variables {α}

/-- Turn an element into its antisymmetrization. -/
def to_antisymmetrization : α → antisymmetrization α r := quotient.mk'

/-- Get a representative from the antisymmetrization. -/
noncomputable def of_antisymmetrization : antisymmetrization α r → α := quotient.out'

instance [inhabited α] : inhabited (antisymmetrization α r) := quotient.inhabited _

@[elab_as_eliminator]
protected lemma antisymmetrization.ind {p : antisymmetrization α r → Prop} :
  (∀ a, p $ to_antisymmetrization r a) → ∀ q, p q :=
quot.ind

@[elab_as_eliminator]
protected lemma antisymmetrization.induction_on {p : antisymmetrization α r → Prop}
  (a : antisymmetrization α r) (h : ∀ a, p $ to_antisymmetrization r a) : p a :=
quotient.induction_on' a h

@[simp] lemma to_antisymmetrization_of_antisymmetrization (a : antisymmetrization α r) :
  to_antisymmetrization r (of_antisymmetrization r a) = a := quotient.out_eq' _

end is_preorder

section preorder
variables {α} [preorder α] [preorder β] {a b : α}

lemma antisymm_rel.image {a b : α} (h : antisymm_rel (≤) a b) {f : α → β} (hf : monotone f) :
  antisymm_rel (≤) (f a) (f b) :=
⟨hf h.1, hf h.2⟩

instance : partial_order (antisymmetrization α (≤)) :=
{ le := λ a b, quotient.lift_on₂' a b (≤) $ λ (a₁ a₂ b₁ b₂ : α) h₁ h₂,
    propext ⟨λ h, h₁.2.trans $ h.trans h₂.1, λ h, h₁.1.trans $ h.trans h₂.2⟩,
  lt := λ a b, quotient.lift_on₂' a b (<) $ λ (a₁ a₂ b₁ b₂ : α) h₁ h₂,
    propext ⟨λ h, h₁.2.trans_lt $ h.trans_le h₂.1, λ h, h₁.1.trans_lt $ h.trans_le h₂.2⟩,
  le_refl := λ a, quotient.induction_on' a $ le_refl,
  le_trans := λ a b c, quotient.induction_on₃' a b c $ λ a b c, le_trans,
  lt_iff_le_not_le := λ a b, quotient.induction_on₂' a b $ λ a b, lt_iff_le_not_le,
  le_antisymm := λ a b, quotient.induction_on₂' a b $ λ a b hab hba, quotient.sound' ⟨hab, hba⟩ }

-- TODO@Yaël: Make computable by adding the missing decidability instances for `quotient.lift` and
-- `quotient.lift₂`
noncomputable instance [is_total α (≤)] : linear_order (antisymmetrization α (≤)) :=
{ le_total := λ a b, quotient.induction_on₂' a b $ total_of (≤),
  decidable_eq := classical.dec_rel _,
  decidable_le := classical.dec_rel _,
  decidable_lt := classical.dec_rel _,
  ..antisymmetrization.partial_order }

@[simp] lemma to_antisymmetrization_le_to_antisymmetrization_iff :
  to_antisymmetrization (≤) a ≤ to_antisymmetrization (≤) b ↔ a ≤ b := iff.rfl

@[simp] lemma to_antisymmetrization_lt_to_antisymmetrization_iff :
  to_antisymmetrization (≤) a < to_antisymmetrization (≤) b ↔ a < b := iff.rfl

@[simp] lemma of_antisymmetrization_le_of_antisymmetrization_iff {a b : antisymmetrization α (≤)} :
  of_antisymmetrization (≤) a ≤ of_antisymmetrization (≤) b ↔ a ≤ b :=
by convert to_antisymmetrization_le_to_antisymmetrization_iff.symm;
  exact (to_antisymmetrization_of_antisymmetrization _ _).symm

@[simp] lemma of_antisymmetrization_lt_of_antisymmetrization_iff {a b : antisymmetrization α (≤)} :
  of_antisymmetrization (≤) a < of_antisymmetrization (≤) b ↔ a < b :=
by convert to_antisymmetrization_lt_to_antisymmetrization_iff.symm;
  exact (to_antisymmetrization_of_antisymmetrization _ _).symm

@[mono] lemma to_antisymmetrization_mono : monotone (@to_antisymmetrization α (≤) _) := λ a b, id

/-- `to_antisymmetrization` as an order homomorphism. -/
@[simps] def order_hom.to_antisymmetrization : α →o antisymmetrization α (≤) :=
⟨to_antisymmetrization (≤), λ a b, id⟩

private lemma lift_fun_antisymm_rel (f : α →o β) :
  ((antisymm_rel.setoid α (≤)).r ⇒ (antisymm_rel.setoid β (≤)).r) f f :=
λ a b h, ⟨f.mono h.1, f.mono h.2⟩

/-- Turns an order homomorphism from `α` to `β` into one from `antisymmetrization α` to
`antisymmetrization β`. `antisymmetrization` is actually a functor. See `Preorder_to_PartialOrder`.
-/
protected def order_hom.antisymmetrization (f : α →o β) :
  antisymmetrization α (≤) →o antisymmetrization β (≤) :=
⟨quotient.map' f $ lift_fun_antisymm_rel f, λ a b, quotient.induction_on₂' a b $ f.mono⟩

@[simp] lemma order_hom.coe_antisymmetrization (f : α →o β) :
  ⇑f.antisymmetrization = quotient.map' f (lift_fun_antisymm_rel f) := rfl

@[simp] lemma order_hom.antisymmetrization_apply (f : α →o β) (a : antisymmetrization α (≤)) :
  f.antisymmetrization a = quotient.map' f (lift_fun_antisymm_rel f) a := rfl

@[simp] lemma order_hom.antisymmetrization_apply_mk (f : α →o β) (a : α) :
  f.antisymmetrization (to_antisymmetrization _ a) = (to_antisymmetrization _ (f a)) :=
quotient.map'_mk' f (lift_fun_antisymm_rel f) _

variables (α)

/-- `of_antisymmetrization` as an order embedding. -/
@[simps] noncomputable def order_embedding.of_antisymmetrization : antisymmetrization α (≤) ↪o α :=
{ to_fun := of_antisymmetrization _,
  inj' := λ _ _, quotient.out_inj.1,
  map_rel_iff' := λ a b, of_antisymmetrization_le_of_antisymmetrization_iff }

/-- `antisymmetrization` and `order_dual` commute. -/
def order_iso.dual_antisymmetrization :
  order_dual (antisymmetrization α (≤)) ≃o antisymmetrization (order_dual α) (≤) :=
{ to_fun := quotient.map' id $ λ _ _, and.symm,
  inv_fun := quotient.map' id $ λ _ _, and.symm,
  left_inv := λ a, quotient.induction_on' a $ λ a, by simp_rw [quotient.map'_mk', id],
  right_inv := λ a, quotient.induction_on' a $ λ a, by simp_rw [quotient.map'_mk', id],
  map_rel_iff' := λ a b, quotient.induction_on₂' a b $ λ a b, iff.rfl }

@[simp] lemma order_iso.dual_antisymmetrization_apply (a : α) :
  order_iso.dual_antisymmetrization _ (to_dual $ to_antisymmetrization _ a) =
    to_antisymmetrization _ (to_dual a) := rfl

@[simp] lemma order_iso.dual_antisymmetrization_symm_apply (a : α) :
  (order_iso.dual_antisymmetrization _).symm (to_antisymmetrization _ $ to_dual a) =
    to_dual (to_antisymmetrization _ a) := rfl

end preorder


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Mario Carneiro, Kevin Buzzard, Yury Kudryashov, Frédéric Dupuis,
  Heather Macbeth
-/
import linear_algebra.basic
import order.omega_complete_partial_order

/-!
# The span of a set of vectors, as a submodule

* `submodule.span s` is defined to be the smallest submodule containing the set `s`.

## Notations

* We introduce the notation `R ∙ v` for the span of a singleton, `submodule.span R {v}`.  This is
  `\.`, not the same as the scalar multiplication `•`/`\bub`.

-/
variables {R R₂ K M M₂ V S : Type*}

namespace submodule

open function set
open_locale pointwise

section add_comm_monoid

variables [semiring R] [add_comm_monoid M] [module R M]
variables {x : M} (p p' : submodule R M)
variables [semiring R₂] {σ₁₂ : R →+* R₂}
variables [add_comm_monoid M₂] [module R₂ M₂]

section
variables (R)

/-- The span of a set `s ⊆ M` is the smallest submodule of M that contains `s`. -/
def span (s : set M) : submodule R M := Inf {p | s ⊆ p}
end

variables {s t : set M}
lemma mem_span : x ∈ span R s ↔ ∀ p : submodule R M, s ⊆ p → x ∈ p := mem_Inter₂

lemma subset_span : s ⊆ span R s :=
λ x h, mem_span.2 $ λ p hp, hp h

lemma span_le {p} : span R s ≤ p ↔ s ⊆ p :=
⟨subset.trans subset_span, λ ss x h, mem_span.1 h _ ss⟩

lemma span_mono (h : s ⊆ t) : span R s ≤ span R t :=
span_le.2 $ subset.trans h subset_span

lemma span_eq_of_le (h₁ : s ⊆ p) (h₂ : p ≤ span R s) : span R s = p :=
le_antisymm (span_le.2 h₁) h₂

lemma span_eq : span R (p : set M) = p :=
span_eq_of_le _ (subset.refl _) subset_span

/-- A version of `submodule.span_eq` for when the span is by a smaller ring. -/
@[simp] lemma span_coe_eq_restrict_scalars
  [semiring S] [has_scalar S R] [module S M] [is_scalar_tower S R M] :
  span S (p : set M) = p.restrict_scalars S :=
span_eq (p.restrict_scalars S)

lemma map_span [ring_hom_surjective σ₁₂] (f : M →ₛₗ[σ₁₂] M₂) (s : set M) :
  (span R s).map f = span R₂ (f '' s) :=
eq.symm $ span_eq_of_le _ (set.image_subset f subset_span) $
map_le_iff_le_comap.2 $ span_le.2 $ λ x hx, subset_span ⟨x, hx, rfl⟩

alias submodule.map_span ← linear_map.map_span

lemma map_span_le [ring_hom_surjective σ₁₂] (f : M →ₛₗ[σ₁₂] M₂) (s : set M)
  (N : submodule R₂ M₂) : map f (span R s) ≤ N ↔ ∀ m ∈ s, f m ∈ N :=
begin
  rw [f.map_span, span_le, set.image_subset_iff],
  exact iff.rfl
end

alias submodule.map_span_le ← linear_map.map_span_le

@[simp] lemma span_insert_zero : span R (insert (0 : M) s) = span R s :=
begin
  refine le_antisymm _ (submodule.span_mono (set.subset_insert 0 s)),
  rw [span_le, set.insert_subset],
  exact ⟨by simp only [set_like.mem_coe, submodule.zero_mem], submodule.subset_span⟩,
end

/- See also `span_preimage_eq` below. -/
lemma span_preimage_le (f : M →ₛₗ[σ₁₂] M₂) (s : set M₂) :
  span R (f ⁻¹' s) ≤ (span R₂ s).comap f :=
by { rw [span_le, comap_coe], exact preimage_mono (subset_span), }

alias submodule.span_preimage_le  ← linear_map.span_preimage_le

/-- An induction principle for span membership. If `p` holds for 0 and all elements of `s`, and is
preserved under addition and scalar multiplication, then `p` holds for all elements of the span of
`s`. -/
@[elab_as_eliminator] lemma span_induction {p : M → Prop} (h : x ∈ span R s)
  (Hs : ∀ x ∈ s, p x) (H0 : p 0)
  (H1 : ∀ x y, p x → p y → p (x + y))
  (H2 : ∀ (a:R) x, p x → p (a • x)) : p x :=
(@span_le _ _ _ _ _ _ ⟨p, H1, H0, H2⟩).2 Hs h

/-- A dependent version of `submodule.span_induction`. -/
lemma span_induction' {p : Π x, x ∈ span R s → Prop}
  (Hs : ∀ x (h : x ∈ s), p x (subset_span h))
  (H0 : p 0 (submodule.zero_mem _))
  (H1 : ∀ x hx y hy, p x hx → p y hy → p (x + y) (submodule.add_mem _ ‹_› ‹_›))
  (H2 : ∀ (a : R) x hx, p x hx → p (a • x) (submodule.smul_mem _ _ ‹_›)) {x} (hx : x ∈ span R s) :
  p x hx :=
begin
  refine exists.elim _ (λ (hx : x ∈ span R s) (hc : p x hx), hc),
  refine span_induction hx (λ m hm, ⟨subset_span hm, Hs m hm⟩) ⟨zero_mem _, H0⟩
    (λ x y hx hy, exists.elim hx $ λ hx' hx, exists.elim hy $ λ hy' hy,
    ⟨add_mem _ hx' hy', H1 _ _ _ _ hx hy⟩) (λ r x hx, exists.elim hx $ λ hx' hx,
    ⟨smul_mem _ _ hx', H2 r _ _ hx⟩)
end

@[simp] lemma span_span_coe_preimage : span R ((coe : span R s → M) ⁻¹' s) = ⊤ :=
eq_top_iff.2 $ λ x, subtype.rec_on x $ λ x hx _, begin
  refine span_induction' (λ x hx, _) _ (λ x y _ _, _) (λ r x _, _) hx,
  { exact subset_span hx },
  { exact zero_mem _ },
  { exact add_mem _ },
  { exact smul_mem _ _ }
end

lemma span_nat_eq_add_submonoid_closure (s : set M) :
  (span ℕ s).to_add_submonoid = add_submonoid.closure s :=
begin
  refine eq.symm (add_submonoid.closure_eq_of_le subset_span _),
  apply add_submonoid.to_nat_submodule.symm.to_galois_connection.l_le _,
  rw span_le,
  exact add_submonoid.subset_closure,
end

@[simp] lemma span_nat_eq (s : add_submonoid M) : (span ℕ (s : set M)).to_add_submonoid = s :=
by rw [span_nat_eq_add_submonoid_closure, s.closure_eq]

lemma span_int_eq_add_subgroup_closure {M : Type*} [add_comm_group M] (s : set M) :
  (span ℤ s).to_add_subgroup = add_subgroup.closure s :=
eq.symm $ add_subgroup.closure_eq_of_le _ subset_span $ λ x hx, span_induction hx
  (λ x hx, add_subgroup.subset_closure hx) (add_subgroup.zero_mem _)
  (λ _ _, add_subgroup.add_mem _) (λ _ _ _, add_subgroup.zsmul_mem _ ‹_› _)

@[simp]

section
variables (R M)

/-- `span` forms a Galois insertion with the coercion from submodule to set. -/
protected def gi : galois_insertion (@span R M _ _ _) coe :=
{ choice := λ s _, span R s,
  gc := λ s t, span_le,
  le_l_u := λ s, subset_span,
  choice_eq := λ s h, rfl }

end

@[simp] lemma span_empty : span R (∅ : set M) = ⊥ :=
(submodule.gi R M).gc.l_bot

@[simp] lemma span_univ : span R (univ : set M) = ⊤ :=
eq_top_iff.2 $ set_like.le_def.2 $ subset_span

lemma span_union (s t : set M) : span R (s ∪ t) = span R s ⊔ span R t :=
(submodule.gi R M).gc.l_sup

lemma span_Union {ι} (s : ι → set M) : span R (⋃ i, s i) = ⨆ i, span R (s i) :=
(submodule.gi R M).gc.l_supr

lemma span_Union₂ {ι} {κ : ι → Sort*} (s : Π i, κ i → set M) :
  span R (⋃ i j, s i j) = ⨆ i j, span R (s i j) :=
(submodule.gi R M).gc.l_supr₂

lemma span_attach_bUnion [decidable_eq M] {α : Type*} (s : finset α) (f : s → finset M) :
  span R (s.attach.bUnion f : set M) = ⨆ x, span R (f x) :=
by simpa [span_Union]

lemma sup_span : p ⊔ span R s = span R (p ∪ s) :=
by rw [submodule.span_union, p.span_eq]

lemma span_sup : span R s ⊔ p = span R (s ∪ p) :=
by rw [submodule.span_union, p.span_eq]

lemma span_eq_supr_of_singleton_spans (s : set M) : span R s = ⨆ x ∈ s, span R {x} :=
by simp only [←span_Union, set.bUnion_of_singleton s]

lemma span_smul_le (s : set M) (r : R) :
  span R (r • s) ≤ span R s :=
begin
  rw span_le,
  rintros _ ⟨x, hx, rfl⟩,
  exact smul_mem (span R s) r (subset_span hx),
end

lemma subset_span_trans {U V W : set M} (hUV : U ⊆ submodule.span R V)
  (hVW : V ⊆ submodule.span R W) :
  U ⊆ submodule.span R W :=
(submodule.gi R M).gc.le_u_l_trans hUV hVW

/-- See `submodule.span_smul_eq` (in `ring_theory.ideal.operations`) for
`span R (r • s) = r • span R s` that holds for arbitrary `r` in a `comm_semiring`. -/
lemma span_smul_eq_of_is_unit (s : set M) (r : R) (hr : is_unit r) :
  span R (r • s) = span R s :=
begin
  apply le_antisymm,
  { apply span_smul_le },
  { convert span_smul_le (r • s) ((hr.unit ⁻¹ : _) : R),
    rw smul_smul,
    erw hr.unit.inv_val,
    rw one_smul }
end

@[simp] theorem coe_supr_of_directed {ι} [hι : nonempty ι]
  (S : ι → submodule R M) (H : directed (≤) S) :
  ((supr S : submodule R M) : set M) = ⋃ i, S i :=
begin
  refine subset.antisymm _ (Union_subset $ le_supr S),
  suffices : (span R (⋃ i, (S i : set M)) : set M) ⊆ ⋃ (i : ι), ↑(S i),
    by simpa only [span_Union, span_eq] using this,
  refine (λ x hx, span_induction hx (λ _, id) _ _ _);
    simp only [mem_Union, exists_imp_distrib],
  { exact hι.elim (λ i, ⟨i, (S i).zero_mem⟩) },
  { intros x y i hi j hj,
    rcases H i j with ⟨k, ik, jk⟩,
    exact ⟨k, add_mem _ (ik hi) (jk hj)⟩ },
  { exact λ a x i hi, ⟨i, smul_mem _ a hi⟩ },
end

@[simp] theorem mem_supr_of_directed {ι} [nonempty ι]
  (S : ι → submodule R M) (H : directed (≤) S) {x} :
  x ∈ supr S ↔ ∃ i, x ∈ S i :=
by { rw [← set_like.mem_coe, coe_supr_of_directed S H, mem_Union], refl }

theorem mem_Sup_of_directed {s : set (submodule R M)}
  {z} (hs : s.nonempty) (hdir : directed_on (≤) s) :
  z ∈ Sup s ↔ ∃ y ∈ s, z ∈ y :=
begin
  haveI : nonempty s := hs.to_subtype,
  simp only [Sup_eq_supr', mem_supr_of_directed _ hdir.directed_coe, set_coe.exists, subtype.coe_mk]
end

@[norm_cast, simp] lemma coe_supr_of_chain (a : ℕ →o submodule R M) :
  (↑(⨆ k, a k) : set M) = ⋃ k, (a k : set M) :=
coe_supr_of_directed a a.monotone.directed_le

/-- We can regard `coe_supr_of_chain` as the statement that `coe : (submodule R M) → set M` is
Scott continuous for the ω-complete partial order induced by the complete lattice structures. -/
lemma coe_scott_continuous : omega_complete_partial_order.continuous'
  (coe : submodule R M → set M) :=
⟨set_like.coe_mono, coe_supr_of_chain⟩

@[simp] lemma mem_supr_of_chain (a : ℕ →o submodule R M) (m : M) :
  m ∈ (⨆ k, a k) ↔ ∃ k, m ∈ a k :=
mem_supr_of_directed a a.monotone.directed_le

section

variables {p p'}

lemma mem_sup : x ∈ p ⊔ p' ↔ ∃ (y ∈ p) (z ∈ p'), y + z = x :=
⟨λ h, begin
  rw [← span_eq p, ← span_eq p', ← span_union] at h,
  apply span_induction h,
  { rintro y (h | h),
    { exact ⟨y, h, 0, by simp, by simp⟩ },
    { exact ⟨0, by simp, y, h, by simp⟩ } },
  { exact ⟨0, by simp, 0, by simp⟩ },
  { rintro _ _ ⟨y₁, hy₁, z₁, hz₁, rfl⟩ ⟨y₂, hy₂, z₂, hz₂, rfl⟩,
    exact ⟨_, add_mem _ hy₁ hy₂, _, add_mem _ hz₁ hz₂, by simp [add_assoc]; cc⟩ },
  { rintro a _ ⟨y, hy, z, hz, rfl⟩,
    exact ⟨_, smul_mem _ a hy, _, smul_mem _ a hz, by simp [smul_add]⟩ }
end,
by rintro ⟨y, hy, z, hz, rfl⟩; exact add_mem _
  ((le_sup_left : p ≤ p ⊔ p') hy)
  ((le_sup_right : p' ≤ p ⊔ p') hz)⟩

lemma mem_sup' : x ∈ p ⊔ p' ↔ ∃ (y : p) (z : p'), (y:M) + z = x :=
mem_sup.trans $ by simp only [set_like.exists, coe_mk]

variables (p p')

lemma coe_sup : ↑(p ⊔ p') = (p + p' : set M) :=
by { ext, rw [set_like.mem_coe, mem_sup, set.mem_add], simp, }

lemma sup_to_add_submonoid :
  (p ⊔ p').to_add_submonoid = p.to_add_submonoid ⊔ p'.to_add_submonoid :=
begin
  ext x,
  rw [mem_to_add_submonoid, mem_sup, add_submonoid.mem_sup],
  refl,
end

lemma sup_to_add_subgroup {R M : Type*} [ring R] [add_comm_group M] [module R M]
  (p p' : submodule R M) :
  (p ⊔ p').to_add_subgroup = p.to_add_subgroup ⊔ p'.to_add_subgroup :=
begin
  ext x,
  rw [mem_to_add_subgroup, mem_sup, add_subgroup.mem_sup],
  refl,
end

end

/- This is the character `∙`, with escape sequence `\.`, and is thus different from the scalar
multiplication character `•`, with escape sequence `\bub`. -/
notation R`∙`:1000 x := span R (@singleton _ _ set.has_singleton x)

lemma mem_span_singleton_self (x : M) : x ∈ R ∙ x := subset_span rfl

lemma nontrivial_span_singleton {x : M} (h : x ≠ 0) : nontrivial (R ∙ x) :=
⟨begin
    use [0, x, submodule.mem_span_singleton_self x],
    intros H,
    rw [eq_comm, submodule.mk_eq_zero] at H,
    exact h H
end⟩

lemma mem_span_singleton {y : M} : x ∈ (R ∙ y) ↔ ∃ a:R, a • y = x :=
⟨λ h, begin
  apply span_induction h,
  { rintro y (rfl|⟨⟨⟩⟩), exact ⟨1, by simp⟩ },
  { exact ⟨0, by simp⟩ },
  { rintro _ _ ⟨a, rfl⟩ ⟨b, rfl⟩,
    exact ⟨a + b, by simp [add_smul]⟩ },
  { rintro a _ ⟨b, rfl⟩,
    exact ⟨a * b, by simp [smul_smul]⟩ }
end,
by rintro ⟨a, y, rfl⟩; exact
  smul_mem _ _ (subset_span $ by simp)⟩

lemma le_span_singleton_iff {s : submodule R M} {v₀ : M} :
  s ≤ (R ∙ v₀) ↔ ∀ v ∈ s, ∃ r : R, r • v₀ = v :=
by simp_rw [set_like.le_def, mem_span_singleton]

variables (R)

lemma span_singleton_eq_top_iff (x : M) : (R ∙ x) = ⊤ ↔ ∀ v, ∃ r : R, r • x = v :=
by { rw [eq_top_iff, le_span_singleton_iff], tauto }

@[simp] lemma span_zero_singleton : (R ∙ (0:M)) = ⊥ :=
by { ext, simp [mem_span_singleton, eq_comm] }

lemma span_singleton_eq_range (y : M) : ↑(R ∙ y) = range ((• y) : R → M) :=
set.ext $ λ x, mem_span_singleton

lemma span_singleton_smul_le {S} [monoid S] [has_scalar S R] [mul_action S M]
  [is_scalar_tower S R M] (r : S) (x : M) : (R ∙ (r • x)) ≤ R ∙ x :=
begin
  rw [span_le, set.singleton_subset_iff, set_like.mem_coe],
  exact smul_of_tower_mem _ _ (mem_span_singleton_self _)
end

lemma span_singleton_group_smul_eq {G} [group G] [has_scalar G R] [mul_action G M]
  [is_scalar_tower G R M] (g : G) (x : M) : (R ∙ (g • x)) = R ∙ x :=
begin
  refine le_antisymm (span_singleton_smul_le R g x) _,
  convert span_singleton_smul_le R (g⁻¹) (g • x),
  exact (inv_smul_smul g x).symm
end

variables {R}

lemma span_singleton_smul_eq {r : R} (hr : is_unit r) (x : M) : (R ∙ (r • x)) = R ∙ x :=
begin
  lift r to Rˣ using hr,
  rw ←units.smul_def,
  exact span_singleton_group_smul_eq R r x,
end

lemma disjoint_span_singleton {K E : Type*} [division_ring K] [add_comm_group E] [module K E]
  {s : submodule K E} {x : E} :
  disjoint s (K ∙ x) ↔ (x ∈ s → x = 0) :=
begin
  refine disjoint_def.trans ⟨λ H hx, H x hx $ subset_span $ mem_singleton x, _⟩,
  assume H y hy hyx,
  obtain ⟨c, rfl⟩ := mem_span_singleton.1 hyx,
  by_cases hc : c = 0,
  { rw [hc, zero_smul] },
  { rw [s.smul_mem_iff hc] at hy,
    rw [H hy, smul_zero] }
end

lemma disjoint_span_singleton' {K E : Type*} [division_ring K] [add_comm_group E] [module K E]
  {p : submodule K E} {x : E} (x0 : x ≠ 0) :
  disjoint p (K ∙ x) ↔ x ∉ p :=
disjoint_span_singleton.trans ⟨λ h₁ h₂, x0 (h₁ h₂), λ h₁ h₂, (h₁ h₂).elim⟩

lemma mem_span_singleton_trans {x y z : M} (hxy : x ∈ R ∙ y) (hyz : y ∈ R ∙ z) :
  x ∈ R ∙ z :=
begin
  rw [← set_like.mem_coe, ← singleton_subset_iff] at *,
  exact submodule.subset_span_trans hxy hyz
end

lemma mem_span_insert {y} : x ∈ span R (insert y s) ↔ ∃ (a:R) (z ∈ span R s), x = a • y + z :=
begin
  simp only [← union_singleton, span_union, mem_sup, mem_span_singleton, exists_prop,
    exists_exists_eq_and],
  rw [exists_comm],
  simp only [eq_comm, add_comm, exists_and_distrib_left]
end

lemma span_insert (x) (s : set M) : span R (insert x s) = span R ({x} : set M) ⊔ span R s :=
by rw [insert_eq, span_union]

lemma span_insert_eq_span (h : x ∈ span R s) : span R (insert x s) = span R s :=
span_eq_of_le _ (set.insert_subset.mpr ⟨h, subset_span⟩) (span_mono $ subset_insert _ _)

lemma span_span : span R (span R s : set M) = span R s := span_eq _

variables (R S s)

/-- If `R` is "smaller" ring than `S` then the span by `R` is smaller than the span by `S`. -/
lemma span_le_restrict_scalars [semiring S] [has_scalar R S] [module S M] [is_scalar_tower R S M] :
  span R s ≤ (span S s).restrict_scalars R :=
submodule.span_le.2 submodule.subset_span

/-- A version of `submodule.span_le_restrict_scalars` with coercions. -/
@[simp] lemma span_subset_span [semiring S] [has_scalar R S] [module S M] [is_scalar_tower R S M] :
  ↑(span R s) ⊆ (span S s : set M) :=
span_le_restrict_scalars R S s

/-- Taking the span by a large ring of the span by the small ring is the same as taking the span
by just the large ring. -/
lemma span_span_of_tower [semiring S] [has_scalar R S] [module S M] [is_scalar_tower R S M] :
  span S (span R s : set M) = span S s :=
le_antisymm (span_le.2 $ span_subset_span R S s) (span_mono subset_span)

variables {R S s}

lemma span_eq_bot : span R (s : set M) = ⊥ ↔ ∀ x ∈ s, (x:M) = 0 :=
eq_bot_iff.trans ⟨
  λ H x h, (mem_bot R).1 $ H $ subset_span h,
  λ H, span_le.2 (λ x h, (mem_bot R).2 $ H x h)⟩

@[simp] lemma span_singleton_eq_bot : (R ∙ x) = ⊥ ↔ x = 0 :=
span_eq_bot.trans $ by simp

@[simp] lemma span_zero : span R (0 : set M) = ⊥ := by rw [←singleton_zero, span_singleton_eq_bot]

lemma span_singleton_eq_span_singleton {R M : Type*} [ring R] [add_comm_group M] [module R M]
  [no_zero_smul_divisors R M] {x y : M} : (R ∙ x) = (R ∙ y) ↔ ∃ z : Rˣ, z • x = y :=
begin
  by_cases hx : x = 0,
  { rw [hx, span_zero_singleton, eq_comm, span_singleton_eq_bot],
    exact ⟨λ hy, ⟨1, by rw [hy, smul_zero]⟩, λ ⟨_, hz⟩, by rw [← hz, smul_zero]⟩ },
  by_cases hy : y = 0,
  { rw [hy, span_zero_singleton, span_singleton_eq_bot],
    exact ⟨λ hx, ⟨1, by rw [hx, smul_zero]⟩, λ ⟨z, hz⟩, (smul_eq_zero_iff_eq z).mp hz⟩ },
  split,
  { intro hxy,
    cases mem_span_singleton.mp (by { rw [hxy], apply mem_span_singleton_self }) with v hv,
    cases mem_span_singleton.mp (by { rw [← hxy], apply mem_span_singleton_self }) with i hi,
    have vi : v * i = 1 :=
    by { rw [← one_smul R y, ← hi, smul_smul] at hv, exact smul_left_injective R hy hv },
    have iv : i * v = 1 :=
    by { rw [← one_smul R x, ← hv, smul_smul] at hi, exact smul_left_injective R hx hi },
    exact ⟨⟨v, i, vi, iv⟩, hv⟩ },
  { rintro ⟨v, rfl⟩,
    rw span_singleton_group_smul_eq }
end

@[simp] lemma span_image [ring_hom_surjective σ₁₂] (f : M →ₛₗ[σ₁₂] M₂) :
  span R₂ (f '' s) = map f (span R s) :=
(map_span f s).symm

lemma apply_mem_span_image_of_mem_span
   [ring_hom_surjective σ₁₂] (f : M →ₛₗ[σ₁₂] M₂) {x : M} {s : set M} (h : x ∈ submodule.span R s) :
   f x ∈ submodule.span R₂ (f '' s) :=
begin
  rw submodule.span_image,
  exact submodule.mem_map_of_mem h
end

@[simp] lemma map_subtype_span_singleton {p : submodule R M} (x : p) :
  map p.subtype (R ∙ x) = R ∙ (x : M) :=
by simp [← span_image]

/-- `f` is an explicit argument so we can `apply` this theorem and obtain `h` as a new goal. -/
lemma not_mem_span_of_apply_not_mem_span_image
   [ring_hom_surjective σ₁₂] (f : M →ₛₗ[σ₁₂] M₂) {x : M} {s : set M}
   (h : f x ∉ submodule.span R₂ (f '' s)) :
   x ∉ submodule.span R s :=
h.imp (apply_mem_span_image_of_mem_span f)

lemma supr_eq_span {ι : Sort*} (p : ι → submodule R M) :
  (⨆ (i : ι), p i) = submodule.span R (⋃ (i : ι), ↑(p i)) :=
le_antisymm
  (supr_le $ assume i, subset.trans (assume m hm, set.mem_Union.mpr ⟨i, hm⟩) subset_span)
  (span_le.mpr $ Union_subset_iff.mpr $ assume i m hm, mem_supr_of_mem i hm)

lemma supr_to_add_submonoid {ι : Sort*} (p : ι → submodule R M) :
  (⨆ i, p i).to_add_submonoid = ⨆ i, (p i).to_add_submonoid :=
begin
  refine le_antisymm (λ x, _) (supr_le $ λ i, to_add_submonoid_mono $ le_supr _ i),
  simp_rw [supr_eq_span, add_submonoid.supr_eq_closure, mem_to_add_submonoid, coe_to_add_submonoid],
  intros hx,
  refine submodule.span_induction hx (λ x hx, _) _ (λ x y hx hy, _) (λ r x hx, _),
  { exact add_submonoid.subset_closure hx },
  { exact add_submonoid.zero_mem _ },
  { exact add_submonoid.add_mem _ hx hy },
  { apply add_submonoid.closure_induction hx,
    { rintros x ⟨_, ⟨i, rfl⟩, hix : x ∈ p i⟩,
      apply add_submonoid.subset_closure (set.mem_Union.mpr ⟨i, _⟩),
      exact smul_mem _ r hix },
    { rw smul_zero,
      exact add_submonoid.zero_mem _ },
    { intros x y hx hy,
      rw smul_add,
      exact add_submonoid.add_mem _ hx hy, } }
end

/-- An induction principle for elements of `⨆ i, p i`.
If `C` holds for `0` and all elements of `p i` for all `i`, and is preserved under addition,
then it holds for all elements of the supremum of `p`. -/
@[elab_as_eliminator]
lemma supr_induction {ι : Sort*} (p : ι → submodule R M) {C : M → Prop} {x : M} (hx : x ∈ ⨆ i, p i)
  (hp : ∀ i (x ∈ p i), C x)
  (h0 : C 0)
  (hadd : ∀ x y, C x → C y → C (x + y)) : C x :=
begin
  rw [←mem_to_add_submonoid, supr_to_add_submonoid] at hx,
  exact add_submonoid.supr_induction _ hx hp h0 hadd,
end

/-- A dependent version of `submodule.supr_induction`. -/
@[elab_as_eliminator]
lemma supr_induction' {ι : Sort*} (p : ι → submodule R M) {C : Π x, (x ∈ ⨆ i, p i) → Prop}
  (hp : ∀ i (x ∈ p i), C x (mem_supr_of_mem i ‹_›))
  (h0 : C 0 (zero_mem _))
  (hadd : ∀ x y hx hy, C x hx → C y hy → C (x + y) (add_mem _ ‹_› ‹_›))
  {x : M} (hx : x ∈ ⨆ i, p i) : C x hx :=
begin
  refine exists.elim _ (λ (hx : x ∈ ⨆ i, p i) (hc : C x hx), hc),
  refine supr_induction p hx (λ i x hx, _) _ (λ x y, _),
  { exact ⟨_, hp _ _ hx⟩ },
  { exact ⟨_, h0⟩ },
  { rintro ⟨_, Cx⟩ ⟨_, Cy⟩,
    refine ⟨_, hadd _ _ _ _ Cx Cy⟩ },
end

@[simp] lemma span_singleton_le_iff_mem (m : M) (p : submodule R M) : (R ∙ m) ≤ p ↔ m ∈ p :=
by rw [span_le, singleton_subset_iff, set_like.mem_coe]

lemma singleton_span_is_compact_element (x : M) :
  complete_lattice.is_compact_element (span R {x} : submodule R M) :=
begin
  rw complete_lattice.is_compact_element_iff_le_of_directed_Sup_le,
  intros d hemp hdir hsup,
  have : x ∈ Sup d, from (set_like.le_def.mp hsup) (mem_span_singleton_self x),
  obtain ⟨y, ⟨hyd, hxy⟩⟩ := (mem_Sup_of_directed hemp hdir).mp this,
  exact ⟨y, ⟨hyd, by simpa only [span_le, singleton_subset_iff]⟩⟩,
end

instance : is_compactly_generated (submodule R M) :=
⟨λ s, ⟨(λ x, span R {x}) '' s, ⟨λ t ht, begin
  rcases (set.mem_image _ _ _).1 ht with ⟨x, hx, rfl⟩,
  apply singleton_span_is_compact_element,
end, by rw [Sup_eq_supr, supr_image, ←span_eq_supr_of_singleton_spans, span_eq]⟩⟩⟩

lemma lt_sup_iff_not_mem {I : submodule R M} {a : M} : I < I ⊔ (R ∙ a) ↔ a ∉ I :=
begin
  split,
  { intro h,
    by_contra akey,
    have h1 : I ⊔ (R ∙ a) ≤ I,
    { simp only [sup_le_iff],
      split,
      { exact le_refl I, },
      { exact (span_singleton_le_iff_mem a I).mpr akey, } },
    have h2 := gt_of_ge_of_gt h1 h,
    exact lt_irrefl I h2, },
  { intro h,
    apply set_like.lt_iff_le_and_exists.mpr, split,
    simp only [le_sup_left],
    use a,
    split, swap, { assumption, },
    { have : (R ∙ a) ≤ I ⊔ (R ∙ a) := le_sup_right,
      exact this (mem_span_singleton_self a), } },
end

lemma mem_supr {ι : Sort*} (p : ι → submodule R M) {m : M} :
  (m ∈ ⨆ i, p i) ↔ (∀ N, (∀ i, p i ≤ N) → m ∈ N) :=
begin
  rw [← span_singleton_le_iff_mem, le_supr_iff],
  simp only [span_singleton_le_iff_mem],
end

section

open_locale classical

/-- For every element in the span of a set, there exists a finite subset of the set
such that the element is contained in the span of the subset. -/
lemma mem_span_finite_of_mem_span {S : set M} {x : M} (hx : x ∈ span R S) :
  ∃ T : finset M, ↑T ⊆ S ∧ x ∈ span R (T : set M) :=
begin
  refine span_induction hx (λ x hx, _) _ _ _,
  { refine ⟨{x}, _, _⟩,
    { rwa [finset.coe_singleton, set.singleton_subset_iff] },
    { rw finset.coe_singleton,
      exact submodule.mem_span_singleton_self x } },
  { use ∅, simp },
  { rintros x y ⟨X, hX, hxX⟩ ⟨Y, hY, hyY⟩,
    refine ⟨X ∪ Y, _, _⟩,
    { rw finset.coe_union,
      exact set.union_subset hX hY },
    rw [finset.coe_union, span_union, mem_sup],
    exact ⟨x, hxX, y, hyY, rfl⟩, },
  { rintros a x ⟨T, hT, h2⟩,
    exact ⟨T, hT, smul_mem _ _ h2⟩ }
end

end

variables {M' : Type*} [add_comm_monoid M'] [module R M'] (q₁ q₁' : submodule R M')

/-- The product of two submodules is a submodule. -/
def prod : submodule R (M × M') :=
{ carrier   := (p : set M) ×ˢ (q₁ : set M'),
  smul_mem' := by rintro a ⟨x, y⟩ ⟨hx, hy⟩; exact ⟨smul_mem _ a hx, smul_mem _ a hy⟩,
  .. p.to_add_submonoid.prod q₁.to_add_submonoid }

@[simp] lemma prod_coe :
  (prod p q₁ : set (M × M')) = (p : set M) ×ˢ (q₁ : set M') := rfl

@[simp] lemma mem_prod {p : submodule R M} {q : submodule R M'} {x : M × M'} :
  x ∈ prod p q ↔ x.1 ∈ p ∧ x.2 ∈ q := set.mem_prod

lemma span_prod_le (s : set M) (t : set M') :
  span R (s ×ˢ t) ≤ prod (span R s) (span R t) :=
span_le.2 $ set.prod_mono subset_span subset_span

@[simp] lemma prod_top : (prod ⊤ ⊤ : submodule R (M × M')) = ⊤ :=
by ext; simp

@[simp] lemma prod_bot : (prod ⊥ ⊥ : submodule R (M × M')) = ⊥ :=
by ext ⟨x, y⟩; simp [prod.zero_eq_mk]

lemma prod_mono {p p' : submodule R M} {q q' : submodule R M'} :
  p ≤ p' → q ≤ q' → prod p q ≤ prod p' q' := prod_mono

@[simp] lemma prod_inf_prod : prod p q₁ ⊓ prod p' q₁' = prod (p ⊓ p') (q₁ ⊓ q₁') :=
set_like.coe_injective set.prod_inter_prod

@[simp] lemma prod_sup_prod : prod p q₁ ⊔ prod p' q₁' = prod (p ⊔ p') (q₁ ⊔ q₁') :=
begin
  refine le_antisymm (sup_le
    (prod_mono le_sup_left le_sup_left)
    (prod_mono le_sup_right le_sup_right)) _,
  simp [set_like.le_def], intros xx yy hxx hyy,
  rcases mem_sup.1 hxx with ⟨x, hx, x', hx', rfl⟩,
  rcases mem_sup.1 hyy with ⟨y, hy, y', hy', rfl⟩,
  refine mem_sup.2 ⟨(x, y), ⟨hx, hy⟩, (x', y'), ⟨hx', hy'⟩, rfl⟩
end

end add_comm_monoid

section add_comm_group

variables [ring R] [add_comm_group M] [module R M]

@[simp] lemma span_neg (s : set M) : span R (-s) = span R s :=
calc span R (-s) = span R ((-linear_map.id : M →ₗ[R] M) '' s) : by simp
 ... = map (-linear_map.id) (span R s) : ((-linear_map.id).map_span _).symm
... = span R s : by simp

lemma mem_span_insert' {x y} {s : set M} : x ∈ span R (insert y s) ↔ ∃(a:R), x + a • y ∈ span R s :=
begin
  rw mem_span_insert, split,
  { rintro ⟨a, z, hz, rfl⟩, exact ⟨-a, by simp [hz, add_assoc]⟩ },
  { rintro ⟨a, h⟩, exact ⟨-a, _, h, by simp [add_comm, add_left_comm]⟩ }
end

instance : is_modular_lattice (submodule R M) :=
⟨λ x y z xz a ha, begin
  rw [mem_inf, mem_sup] at ha,
  rcases ha with ⟨⟨b, hb, c, hc, rfl⟩, haz⟩,
  rw mem_sup,
  refine ⟨b, hb, c, mem_inf.2 ⟨hc, _⟩, rfl⟩,
  rw [← add_sub_cancel c b, add_comm],
  apply z.sub_mem haz (xz hb),
end⟩

end add_comm_group

section add_comm_group

variables [semiring R] [semiring R₂]
variables [add_comm_group M] [module R M] [add_comm_group M₂] [module R₂ M₂]
variables {τ₁₂ : R →+* R₂} [ring_hom_surjective τ₁₂]

lemma comap_map_eq (f : M →ₛₗ[τ₁₂] M₂) (p : submodule R M) :
  comap f (map f p) = p ⊔ f.ker :=
begin
  refine le_antisymm _ (sup_le (le_comap_map _ _) (comap_mono bot_le)),
  rintro x ⟨y, hy, e⟩,
  exact mem_sup.2 ⟨y, hy, x - y, by simpa using sub_eq_zero.2 e.symm, by simp⟩
end

lemma comap_map_eq_self {f : M →ₛₗ[τ₁₂] M₂} {p : submodule R M} (h : f.ker ≤ p) :
  comap f (map f p) = p :=
by rw [submodule.comap_map_eq, sup_of_le_left h]

end add_comm_group

end submodule

namespace linear_map

open submodule function

section add_comm_group

variables [semiring R] [semiring R₂]
variables [add_comm_group M] [add_comm_group M₂]
variables [module R M] [module R₂ M₂]
variables {τ₁₂ : R →+* R₂} [ring_hom_surjective τ₁₂]
include R

protected lemma map_le_map_iff (f : M →ₛₗ[τ₁₂] M₂) {p p'} : map f p ≤ map f p' ↔ p ≤ p' ⊔ ker f :=
by rw [map_le_iff_le_comap, submodule.comap_map_eq]

theorem map_le_map_iff' {f : M →ₛₗ[τ₁₂] M₂} (hf : ker f = ⊥) {p p'} :
  map f p ≤ map f p' ↔ p ≤ p' :=
by rw [linear_map.map_le_map_iff, hf, sup_bot_eq]

theorem map_injective {f : M →ₛₗ[τ₁₂] M₂} (hf : ker f = ⊥) : injective (map f) :=
λ p p' h, le_antisymm ((map_le_map_iff' hf).1 (le_of_eq h)) ((map_le_map_iff' hf).1 (ge_of_eq h))

theorem map_eq_top_iff {f : M →ₛₗ[τ₁₂] M₂} (hf : range f = ⊤) {p : submodule R M} :
  p.map f = ⊤ ↔ p ⊔ f.ker = ⊤ :=
by simp_rw [← top_le_iff, ← hf, range_eq_map, linear_map.map_le_map_iff]

end add_comm_group

section
variables (R) (M) [semiring R] [add_comm_monoid M] [module R M]

/-- Given an element `x` of a module `M` over `R`, the natural map from
    `R` to scalar multiples of `x`.-/
@[simps] def to_span_singleton (x : M) : R →ₗ[R] M := linear_map.id.smul_right x

/-- The range of `to_span_singleton x` is the span of `x`.-/
lemma span_singleton_eq_range (x : M) : (R ∙ x) = (to_span_singleton R M x).range :=
submodule.ext $ λ y, by {refine iff.trans _ linear_map.mem_range.symm, exact mem_span_singleton }

lemma to_span_singleton_one (x : M) : to_span_singleton R M x 1 = x := one_smul _ _

end

section add_comm_monoid

variables [semiring R] [add_comm_monoid M] [module R M]
variables [semiring R₂] [add_comm_monoid M₂] [module R₂ M₂]
variables {σ₁₂ : R →+* R₂}

/-- If two linear maps are equal on a set `s`, then they are equal on `submodule.span s`.

See also `linear_map.eq_on_span'` for a version using `set.eq_on`. -/
lemma eq_on_span {s : set M} {f g : M →ₛₗ[σ₁₂] M₂} (H : set.eq_on f g s) ⦃x⦄ (h : x ∈ span R s) :
  f x = g x :=
by apply span_induction h H; simp {contextual := tt}

/-- If two linear maps are equal on a set `s`, then they are equal on `submodule.span s`.

This version uses `set.eq_on`, and the hidden argument will expand to `h : x ∈ (span R s : set M)`.
See `linear_map.eq_on_span` for a version that takes `h : x ∈ span R s` as an argument. -/
lemma eq_on_span' {s : set M} {f g : M →ₛₗ[σ₁₂] M₂} (H : set.eq_on f g s) :
  set.eq_on f g (span R s : set M) :=
eq_on_span H

/-- If `s` generates the whole module and linear maps `f`, `g` are equal on `s`, then they are
equal. -/
lemma ext_on {s : set M} {f g : M →ₛₗ[σ₁₂] M₂} (hv : span R s = ⊤) (h : set.eq_on f g s) :
  f = g :=
linear_map.ext (λ x, eq_on_span h (eq_top_iff'.1 hv _))

/-- If the range of `v : ι → M` generates the whole module and linear maps `f`, `g` are equal at
each `v i`, then they are equal. -/
lemma ext_on_range {ι : Type*} {v : ι → M} {f g : M →ₛₗ[σ₁₂] M₂} (hv : span R (set.range v) = ⊤)
  (h : ∀i, f (v i) = g (v i)) : f = g :=
ext_on hv (set.forall_range_iff.2 h)

end add_comm_monoid

section field

variables {K V} [field K] [add_comm_group V] [module K V]

noncomputable theory
open_locale classical

lemma span_singleton_sup_ker_eq_top (f : V →ₗ[K] K) {x : V} (hx : f x ≠ 0) :
  (K ∙ x) ⊔ f.ker = ⊤ :=
eq_top_iff.2 (λ y hy, submodule.mem_sup.2 ⟨(f y * (f x)⁻¹) • x,
  submodule.mem_span_singleton.2 ⟨f y * (f x)⁻¹, rfl⟩,
    ⟨y - (f y * (f x)⁻¹) • x,
      by rw [linear_map.mem_ker, f.map_sub, f.map_smul, smul_eq_mul, mul_assoc,
             inv_mul_cancel hx, mul_one, sub_self],
      by simp only [add_sub_cancel'_right]⟩⟩)

variables (K V)

lemma ker_to_span_singleton {x : V} (h : x ≠ 0) : (to_span_singleton K V x).ker = ⊥ :=
begin
  ext c, split,
  { intros hc, rw submodule.mem_bot, rw mem_ker at hc, by_contra hc',
    have : x = 0,
      calc x = c⁻¹ • (c • x) : by rw [← mul_smul, inv_mul_cancel hc', one_smul]
      ... = c⁻¹ • ((to_span_singleton K V x) c) : rfl
      ... = 0 : by rw [hc, smul_zero],
    tauto },
  { rw [mem_ker, submodule.mem_bot], intros h, rw h, simp }
end

end field

end linear_map

open linear_map

namespace linear_equiv

section field

variables (K V) [field K] [add_comm_group V] [module K V]

/-- Given a nonzero element `x` of a vector space `V` over a field `K`, the natural
    map from `K` to the span of `x`, with invertibility check to consider it as an
    isomorphism.-/
def to_span_nonzero_singleton (x : V) (h : x ≠ 0) : K ≃ₗ[K] (K ∙ x) :=
linear_equiv.trans
  (linear_equiv.of_injective
    (linear_map.to_span_singleton K V x) (ker_eq_bot.1 $ linear_map.ker_to_span_singleton K V h))
  (linear_equiv.of_eq (to_span_singleton K V x).range (K ∙ x)
    (span_singleton_eq_range K V x).symm)

lemma to_span_nonzero_singleton_one (x : V) (h : x ≠ 0) :
  linear_equiv.to_span_nonzero_singleton K V x h 1 =
    (⟨x, submodule.mem_span_singleton_self x⟩ : K ∙ x) :=
begin
  apply set_like.coe_eq_coe.mp,
  have : ↑(to_span_nonzero_singleton K V x h 1) = to_span_singleton K V x 1 := rfl,
  rw [this, to_span_singleton_one, submodule.coe_mk],
end

/-- Given a nonzero element `x` of a vector space `V` over a field `K`, the natural map
    from the span of `x` to `K`.-/
abbreviation coord (x : V) (h : x ≠ 0) : (K ∙ x) ≃ₗ[K] K :=
(to_span_nonzero_singleton K V x h).symm

lemma coord_self (x : V) (h : x ≠ 0) :
  (coord K V x h) (⟨x, submodule.mem_span_singleton_self x⟩ : K ∙ x) = 1 :=
by rw [← to_span_nonzero_singleton_one K V x h, linear_equiv.symm_apply_apply]

end field

end linear_equiv