/-
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, Floris van Doorn
-/
import topology.bases
import topology.homeomorph
/-!
# Open sets

## Summary

We define the subtype of open sets in a topological space.

## Main Definitions

- `opens α` is the type of open subsets of a topological space `α`.
- `open_nhds_of x` is the type of open subsets of a topological space `α` containing `x : α`.
-
-/

open filter set
variables {α : Type*} {β : Type*} {γ : Type*}
  [topological_space α] [topological_space β] [topological_space γ]

namespace topological_space
variable (α)
/-- The type of open subsets of a topological space. -/
def opens := {s : set α // is_open s}

variable {α}
namespace opens
instance : has_coe (opens α) (set α) := { coe := subtype.val }

lemma val_eq_coe (U : opens α) : U.1 = ↑U := rfl

/-- the coercion `opens α → set α` applied to a pair is the same as taking the first component -/
lemma coe_mk {α : Type*} [topological_space α] {U : set α} {hU : is_open U} :
  ↑(⟨U, hU⟩ : opens α) = U := rfl

instance : has_subset (opens α) :=
{ subset := λ U V, (U : set α) ⊆ V }

instance : has_mem α (opens α) :=
{ mem := λ a U, a ∈ (U : set α) }

@[simp] lemma subset_coe {U V : opens α} : ((U : set α) ⊆ (V : set α)) = (U ⊆ V) := rfl

@[simp] lemma mem_coe {x : α} {U : opens α} : (x ∈ (U : set α)) = (x ∈ U) := rfl

@[ext] lemma ext {U V : opens α} (h : (U : set α) = V) : U = V := subtype.ext_iff.mpr h

@[ext] lemma ext_iff {U V : opens α} : (U : set α) = V ↔ U = V :=
⟨opens.ext, congr_arg coe⟩

instance : partial_order (opens α) := subtype.partial_order _

/-- The interior of a set, as an element of `opens`. -/
def interior (s : set α) : opens α := ⟨interior s, is_open_interior⟩

lemma gc : galois_connection (coe : opens α → set α) interior :=
λ U s, ⟨λ h, interior_maximal h U.property, λ h, le_trans h interior_subset⟩

/-- The galois insertion between sets and opens, but ordered by reverse inclusion. -/
def gi : @galois_insertion (order_dual (set α)) (order_dual (opens α)) _ _ interior subtype.val :=
{ choice := λ s hs, ⟨s, interior_eq_iff_open.mp $ le_antisymm interior_subset hs⟩,
  gc := gc.dual,
  le_l_u := λ _, interior_subset,
  choice_eq := λ s hs, le_antisymm interior_subset hs }

@[simp] lemma gi_choice_val {s : order_dual (set α)} {hs} : (gi.choice s hs).val = s := rfl

instance : complete_lattice (opens α) :=
complete_lattice.copy
  (@order_dual.complete_lattice _ (galois_insertion.lift_complete_lattice (@gi α _)))
/- le  -/ (λ U V, U ⊆ V) rfl
/- top -/ ⟨set.univ, is_open_univ⟩ (subtype.ext_iff_val.mpr interior_univ.symm)
/- bot -/ ⟨∅, is_open_empty⟩ rfl
/- sup -/ (λ U V, ⟨↑U ∪ ↑V, is_open_union U.2 V.2⟩) rfl
/- inf -/ (λ U V, ⟨↑U ∩ ↑V, is_open_inter U.2 V.2⟩)
begin
  funext,
  apply subtype.ext_iff_val.mpr,
  exact (is_open_inter U.2 V.2).interior_eq.symm,
end
/- Sup -/ (λ Us, ⟨⋃₀ (coe '' Us), is_open_sUnion $ λ U hU,
by { rcases hU with ⟨⟨V, hV⟩, h, h'⟩, dsimp at h', subst h', exact hV}⟩)
begin
  funext,
  apply subtype.ext_iff_val.mpr,
  simp [Sup_range],
  refl,
end
/- Inf -/ _ rfl

lemma le_def {U V : opens α} : U ≤ V ↔ (U : set α) ≤ (V : set α) :=
by refl

@[simp] lemma mk_inf_mk {U V : set α} {hU : is_open U} {hV : is_open V} :
  (⟨U, hU⟩ ⊓ ⟨V, hV⟩ : opens α) = ⟨U ⊓ V, is_open_inter hU hV⟩ := rfl
@[simp,norm_cast] lemma coe_inf {U V : opens α} :
  ((U ⊓ V : opens α) : set α) = (U : set α) ⊓ (V : set α) := rfl

instance : has_inter (opens α) := ⟨λ U V, U ⊓ V⟩
instance : has_union (opens α) := ⟨λ U V, U ⊔ V⟩
instance : has_emptyc (opens α) := ⟨⊥⟩
instance : inhabited (opens α) := ⟨∅⟩

@[simp] lemma inter_eq (U V : opens α) : U ∩ V = U ⊓ V := rfl
@[simp] lemma union_eq (U V : opens α) : U ∪ V = U ⊔ V := rfl
@[simp] lemma empty_eq : (∅ : opens α) = ⊥ := rfl

@[simp] lemma Sup_s {Us : set (opens α)} : ↑(Sup Us) = ⋃₀ ((coe : _ → set α) '' Us) :=
begin
  rw [@galois_connection.l_Sup (opens α) (set α) _ _ (coe : opens α → set α) interior gc Us],
  rw [set.sUnion_image]
end

lemma supr_def {ι} (s : ι → opens α) : (⨆ i, s i) = ⟨⋃ i, s i, is_open_Union $ λ i, (s i).2⟩ :=
by { ext, simp only [supr, opens.Sup_s, sUnion_image, bUnion_range], refl }

@[simp] lemma supr_mk {ι} (s : ι → set α) (h : Π i, is_open (s i)) :
  (⨆ i, ⟨s i, h i⟩ : opens α) = ⟨⨆ i, s i, is_open_Union h⟩ :=
by { rw supr_def, simp }

@[simp] lemma supr_s {ι} (s : ι → opens α) : ((⨆ i, s i : opens α) : set α) = ⋃ i, s i :=
by simp [supr_def]

@[simp] theorem mem_supr {ι} {x : α} {s : ι → opens α} : x ∈ supr s ↔ ∃ i, x ∈ s i :=
by { rw [←mem_coe], simp, }

@[simp] lemma mem_Sup {Us : set (opens α)} {x : α} : x ∈ Sup Us ↔ ∃ u ∈ Us, x ∈ u :=
by simp_rw [Sup_eq_supr, mem_supr]

lemma open_embedding_of_le {U V : opens α} (i : U ≤ V) :
  open_embedding (set.inclusion i) :=
{ inj := set.inclusion_injective i,
  induced := (@induced_compose _ _ _ _ (set.inclusion i) coe).symm,
  open_range :=
  begin
    rw set.range_inclusion i,
    exact U.property.preimage continuous_subtype_val
  end, }

def is_basis (B : set (opens α)) : Prop := is_topological_basis ((coe : _ → set α) '' B)

lemma is_basis_iff_nbhd {B : set (opens α)} :
  is_basis B ↔ ∀ {U : opens α} {x}, x ∈ U → ∃ U' ∈ B, x ∈ U' ∧ U' ⊆ U :=
begin
  split; intro h,
  { rintros ⟨sU, hU⟩ x hx,
    rcases h.mem_nhds_iff.mp (mem_nhds_sets hU hx)
      with ⟨sV, ⟨⟨V, H₁, H₂⟩, hsV⟩⟩,
    refine ⟨V, H₁, _⟩,
    cases V, dsimp at H₂, subst H₂, exact hsV },
  { refine is_topological_basis_of_open_of_nhds _ _,
    { rintros sU ⟨U, ⟨H₁, H₂⟩⟩, subst H₂, exact U.property },
    { intros x sU hx hsU,
      rcases @h (⟨sU, hsU⟩ : opens α) x hx with ⟨V, hV, H⟩,
      exact ⟨V, ⟨V, hV, rfl⟩, H⟩ } }
end

lemma is_basis_iff_cover {B : set (opens α)} :
  is_basis B ↔ ∀ U : opens α, ∃ Us ⊆ B, U = Sup Us :=
begin
  split,
  { intros hB U,
    refine ⟨{V : opens α | V ∈ B ∧ V ⊆ U}, λ U hU, hU.left, _⟩,
    apply ext,
    rw [Sup_s, hB.open_eq_sUnion' U.prop],
    simp_rw [sUnion_image, sUnion_eq_bUnion, Union, supr_and, supr_image],
    refl },
  { intro h,
    rw is_basis_iff_nbhd,
    intros U x hx,
    rcases h U with ⟨Us, hUs, rfl⟩,
    rcases mem_Sup.1 hx with ⟨U, Us, xU⟩,
    exact ⟨U, hUs Us, xU, le_Sup Us⟩ }
end

/-- The preimage of an open set, as an open set. -/
def comap {f : α → β} (hf : continuous f) (V : opens β) : opens α :=
⟨f ⁻¹' V.1, V.2.preimage hf⟩

@[simp] lemma comap_id (U : opens α) : U.comap continuous_id = U := by { ext, refl }

lemma comap_mono {f : α → β} (hf : continuous f) {V W : opens β} (hVW : V ⊆ W) :
  V.comap hf ⊆ W.comap hf :=
λ _ h, hVW h

@[simp] lemma coe_comap {f : α → β} (hf : continuous f) (U : opens β) :
  ↑(U.comap hf) = f ⁻¹' U := rfl

@[simp] lemma comap_val {f : α → β} (hf : continuous f) (U : opens β) :
  (U.comap hf).1 = f ⁻¹' U := rfl

protected lemma comap_comp {g : β → γ} {f : α → β} (hg : continuous g) (hf : continuous f)
  (U : opens γ) : U.comap (hg.comp hf) = (U.comap hg).comap hf :=
by { ext1, simp only [coe_comap, preimage_preimage] }

/-- A homeomorphism induces an equivalence on open sets, by taking comaps. -/
@[simp] protected def equiv (f : α ≃ₜ β) : opens α ≃ opens β :=
{ to_fun := opens.comap f.symm.continuous,
  inv_fun := opens.comap f.continuous,
  left_inv := by { intro U, ext1,
    simp only [coe_comap, ← preimage_comp, f.symm_comp_self, preimage_id] },
  right_inv := by { intro U, ext1,
    simp only [coe_comap, ← preimage_comp, f.self_comp_symm, preimage_id] } }

end opens

/-- The open neighborhoods of a point. See also `opens` or `nhds`. -/
def open_nhds_of (x : α) : Type* := { s : set α // is_open s ∧ x ∈ s }

instance open_nhds_of.inhabited {α : Type*} [topological_space α] (x : α) :
  inhabited (open_nhds_of x) := ⟨⟨set.univ, is_open_univ, set.mem_univ _⟩⟩

end topological_space


/-
Copyright 2020 Google LLC

Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at

      http://www.apache.org/licenses/LICENSE-2.0

Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.
 -/
/-
  This file proves that if a convex function (by the derivative definition) has a derivative
  of zero at a point x, then that is a minimum.
 -/

import analysis.calculus.mean_value
import data.complex.exponential
import formal_ml.real

/-
  Note: consider dropping this definition, and proving this using has_deriv_at already provided.
  has_derivative f f' ↔ differentiable f ∧ deriv f = f'
 -/
def has_derivative (f f':ℝ → ℝ):Prop := (∀ x, has_deriv_at f (f' x) x)

lemma has_derivative.differentiable (f f':ℝ → ℝ):(has_derivative f f') → differentiable ℝ f :=
begin
  intro A1,
  unfold differentiable,
  intro x,
  apply has_deriv_at.differentiable_at,
  apply A1,
end

lemma differentiable.has_derivative (f:ℝ → ℝ):differentiable ℝ f → (has_derivative f (deriv f)) :=
begin
  intro A1,
  unfold differentiable at A1,
  intro x,
  apply differentiable_at.has_deriv_at,
  apply A1,
end

--Unused
lemma has_derivative_add (f f' g g':ℝ → ℝ):
  has_derivative f f' →
  has_derivative g g' →
  has_derivative (f + g) (f' + g') :=
begin
  intros A1 A2 x,
  apply has_deriv_at.add,
  {
    apply A1,
  },
  {
    apply A2,
  }
end

--Used in exp_bound.lean
lemma has_derivative_sub (f f' g g':ℝ → ℝ):
  has_derivative f f' →
  has_derivative g g' →
  has_derivative (f - g) (f' - g') :=
begin
  intros A1 A2 x,
  apply has_deriv_at.sub,
  {
    apply A1,
  },
  {
    apply A2,
  }
end

--Unused
lemma has_derivative_const (k:ℝ):
  has_derivative (λ x:ℝ, k)  (λ x:ℝ, 0) :=
begin
  intro x,
  simp,
  apply has_deriv_at_const,
end

lemma has_derivative_id:
  has_derivative (λ x:ℝ, x)  (λ x:ℝ, 1) :=
begin
  intro x,
  simp,
  apply has_deriv_at_id,
end

lemma has_derivative_neg (f f':ℝ → ℝ):
  has_derivative f f' →
  has_derivative (-f)  (-f') :=
begin
  intros A1 x,
  apply has_deriv_at.neg,
  apply A1,
end

--Used in exp_bound.lean
lemma has_derivative_add_const (f f':ℝ → ℝ) (k:ℝ):
  has_derivative f f' →
  has_derivative (λ x:ℝ, f x + k)  (f') :=
begin
  intros A1 x,
  apply has_deriv_at.add_const,
  apply A1,
end

section convex_optimization
variables (f f' f'': ℝ → ℝ)

lemma exists_has_deriv_at_eq_slope_total (x y:ℝ):
  (has_derivative f f') →
  (x < y) →
  (∃ c ∈ set.Ioo x y, f' c = (f y - f x) / (y - x)) :=
begin
  intros A1 A2,
  apply exists_has_deriv_at_eq_slope,
  {
    exact A2,
  },
  {
    have B1:differentiable ℝ f := has_derivative.differentiable _ _ A1,
    apply continuous.continuous_on,
    apply differentiable.continuous B1,
  },
  {
    intros z C1,
    apply A1,
  }
end

lemma zero_lt_of_neg_lt (x:ℝ):(0 < x) → (-x < 0) := neg_lt_zero.mpr

lemma div_pos_of_pos_of_pos {a b:ℝ}:(0 < a) → (0 < b) → 0 < (a/b) :=
begin
  intros A1 A2,
  rw div_def,
  apply mul_pos,
  apply A1,
  rw inv_pos,
  apply A2,
end

lemma is_minimum (x y:ℝ):
  (has_derivative f f') →
  (has_derivative f' f'')→
  (∀ z, 0 ≤ (f'' z))→
  (f' x = 0) →
  (f x ≤ f y) :=
begin
  intros A1 A2 A3 A4,

  have A5:differentiable ℝ f := has_derivative.differentiable _ _ A1,
  have A6:differentiable ℝ f' := has_derivative.differentiable _ _ A2,
  have A7:continuous f := differentiable.continuous A5,
  have A8:continuous f' := differentiable.continuous A6,
  have A9:(x < y)∨ (x=y) ∨ (y < x) := lt_trichotomy x y,
  cases A9,
  {
    have B1:¬(f y < f x),
    {
      intro B0,
      have B1C:∃ c ∈ set.Ioo x y, f' c = (f y - f x) / (y - x),
      {
        apply exists_has_deriv_at_eq_slope_total,
        apply A1,
        apply A9,
      },
      cases B1C with c B1D,
      cases B1D with B1E B1F,
      have B1G:f' c < 0,
      {
        rw B1F,
        apply div_neg_of_neg_of_pos,
        { -- ⊢ f y - f x < 0
          apply sub_lt_zero.mpr,
          apply B0,
        },
        { -- ⊢ 0 < y - x
          apply sub_pos.mpr,
          apply A9,
        },
      },
      have B1H:x < c,
      {
        have B1H1:x < c ∧ c < y,
        {
          apply set.mem_Ioo.mp,
          exact B1E,
        },
        apply B1H1.left,
      },
      have B1I:∃ d ∈ set.Ioo x c, f'' d = (f' c - f' x) / (c - x),
      {
        apply exists_has_deriv_at_eq_slope_total,
        apply A2,
        apply B1H,
      },
      cases B1I with d B1J,
      cases B1J with BIK B1L,
      have B1M:¬ (f'' d < 0),
      {
        apply not_lt_of_le,
        apply A3,
      },
      apply B1M,
      rw B1L,
      apply div_neg_of_neg_of_pos,
      {
        rw A4,
        simp,
        apply B1G,
      },
      {
        apply sub_pos.mpr,
        apply B1H,
      }
    },
    apply le_of_not_lt B1,
  },
  {
    cases A9,
    {
      rw A9,
    },
    {
      have B1:¬(f y < f x),
      {
        intro B0,
        have B1A:continuous_on f (set.Icc x y),
        {
          apply continuous.continuous_on A7,
        },
        have B1B:differentiable_on ℝ f (set.Ioo y x),
        {
          apply differentiable.differentiable_on A5,
        },
        have B1C:∃ c ∈ set.Ioo y x, f' c = (f x - f y) / (x - y),
        {
          apply exists_has_deriv_at_eq_slope_total,
          apply A1,
          apply A9,
        },
        cases B1C with c B1D,
        cases B1D with B1E B1F,
        have B1G:0 < f' c,
        {
          rw B1F,
          -- y < x, f y < f x ⊢ 0 < (f x - f y) / (x - y)
          -- 0 < x - y, 0 < f x - f y ⊢ 0 < (f x - f y) / (x - y)
          apply div_pos_of_pos_of_pos,
          { -- ⊢ f y - f x < 0
            apply sub_pos.mpr,
            apply B0,
          },
          { -- ⊢ 0 < y - x
            apply sub_pos.mpr,
            apply A9,
          },
        },
        have B1H:c < x,
        {
          have B1H1:y < c ∧ c < x,
          {
            apply set.mem_Ioo.mp,
            exact B1E,
          },
          apply B1H1.right,
        },
        have B1I:∃ d ∈ set.Ioo c x, f'' d = (f' x - f' c) / (x - c),
        {
          apply exists_has_deriv_at_eq_slope_total,
          apply A2,
          apply B1H,
        },
        cases B1I with d B1J,
        cases B1J with BIK B1L,
        have B1M:¬ (f'' d < 0),
        {
          apply not_lt_of_le,
          apply A3,
        },
        apply B1M,
        rw B1L,
        apply div_neg_of_neg_of_pos,
        {
          rw A4,
          simp,
          --apply zero_lt_of_neg_lt,
          apply B1G,
        },
        {
          apply sub_pos.mpr,
          apply B1H,
        }
      },
      apply le_of_not_lt B1,
    }
  }
end

/-
  Lifting the theorem to the mathlib terminology
 -/
lemma is_minimum' (x y:ℝ):
  differentiable ℝ f →
  differentiable ℝ (deriv f) →
  (0 ≤ (deriv (deriv  f)))→
  (deriv f x = 0) →
  (f x ≤ f y) :=
begin
  intros A1 A2 A3 A4,
  let f' := deriv f,
  let f'' := deriv f',
  begin
    have B1:f' = deriv f := rfl,
    have B2:f'' = deriv f' := rfl,
    have C1:=differentiable.has_derivative f A1,
    rw ← B1 at A2,
    have C2:=differentiable.has_derivative f' A2,
    rw ← B2 at C2,
    rw ← B1 at C1,
    rw ← B1 at A3,
    rw ← B2 at A3,
    rw ← B1 at A4,
    apply is_minimum f f' f'' x y C1 C2 A3 A4,
  end
end

end convex_optimization


/-
Copyright (c) 2019 Reid Barton. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Mario Carneiro, Patrick Massot
-/
import topology.separation
import topology.bases

/-!
# Dense embeddings

> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
> Any changes to this file require a corresponding PR to mathlib4.

This file defines three properties of functions:

* `dense_range f`      means `f` has dense image;
* `dense_inducing i`   means `i` is also `inducing`;
* `dense_embedding e`  means `e` is also an `embedding`.

The main theorem `continuous_extend` gives a criterion for a function
`f : X → Z` to a T₃ space Z to extend along a dense embedding
`i : X → Y` to a continuous function `g : Y → Z`. Actually `i` only
has to be `dense_inducing` (not necessarily injective).

-/

noncomputable theory

open set filter
open_locale classical topology filter

variables {α : Type*} {β : Type*} {γ : Type*} {δ : Type*}

/-- `i : α → β` is "dense inducing" if it has dense range and the topology on `α`
  is the one induced by `i` from the topology on `β`. -/
@[protect_proj] structure dense_inducing [topological_space α] [topological_space β] (i : α → β)
  extends inducing i : Prop :=
(dense : dense_range i)

namespace dense_inducing
variables [topological_space α] [topological_space β]
variables {i : α → β} (di : dense_inducing i)

lemma nhds_eq_comap (di : dense_inducing i) :
  ∀ a : α, 𝓝 a = comap i (𝓝 $ i a) :=
di.to_inducing.nhds_eq_comap

protected lemma continuous (di : dense_inducing i) : continuous i :=
di.to_inducing.continuous

lemma closure_range : closure (range i) = univ :=
di.dense.closure_range

protected lemma preconnected_space [preconnected_space α] (di : dense_inducing i) :
  preconnected_space β :=
di.dense.preconnected_space di.continuous

lemma closure_image_mem_nhds {s : set α} {a : α} (di : dense_inducing i) (hs : s ∈ 𝓝 a) :
  closure (i '' s) ∈ 𝓝 (i a) :=
begin
  rw [di.nhds_eq_comap a, ((nhds_basis_opens _).comap _).mem_iff] at hs,
  rcases hs with ⟨U, ⟨haU, hUo⟩, sub : i ⁻¹' U ⊆ s⟩,
  refine mem_of_superset (hUo.mem_nhds haU) _,
  calc U ⊆ closure (i '' (i ⁻¹' U)) : di.dense.subset_closure_image_preimage_of_is_open hUo
     ... ⊆ closure (i '' s)         : closure_mono (image_subset i sub)
end

lemma dense_image (di : dense_inducing i) {s : set α} : dense (i '' s) ↔ dense s :=
begin
  refine ⟨λ H x, _, di.dense.dense_image di.continuous⟩,
  rw [di.to_inducing.closure_eq_preimage_closure_image, H.closure_eq, preimage_univ],
  trivial
end

/-- If `i : α → β` is a dense embedding with dense complement of the range, then any compact set in
`α` has empty interior. -/
lemma interior_compact_eq_empty [t2_space β] (di : dense_inducing i) (hd : dense (range i)ᶜ)
  {s : set α} (hs : is_compact s) : interior s = ∅ :=
begin
  refine eq_empty_iff_forall_not_mem.2 (λ x hx, _),
  rw [mem_interior_iff_mem_nhds] at hx,
  have := di.closure_image_mem_nhds hx,
  rw (hs.image di.continuous).is_closed.closure_eq at this,
  rcases hd.inter_nhds_nonempty this with ⟨y, hyi, hys⟩,
  exact hyi (image_subset_range _ _ hys)
end

/-- The product of two dense inducings is a dense inducing -/
protected lemma prod [topological_space γ] [topological_space δ]
  {e₁ : α → β} {e₂ : γ → δ} (de₁ : dense_inducing e₁) (de₂ : dense_inducing e₂) :
  dense_inducing (λ(p : α × γ), (e₁ p.1, e₂ p.2)) :=
{ induced := (de₁.to_inducing.prod_mk de₂.to_inducing).induced,
  dense := de₁.dense.prod_map de₂.dense }

open topological_space

/-- If the domain of a `dense_inducing` map is a separable space, then so is the codomain. -/
protected lemma separable_space [separable_space α] : separable_space β :=
di.dense.separable_space di.continuous

variables [topological_space δ] {f : γ → α} {g : γ → δ} {h : δ → β}
/--
```
 γ -f→ α
g↓     ↓e
 δ -h→ β
```
-/
lemma tendsto_comap_nhds_nhds  {d : δ} {a : α} (di : dense_inducing i)
  (H : tendsto h (𝓝 d) (𝓝 (i a))) (comm : h ∘ g = i ∘ f) : tendsto f (comap g (𝓝 d)) (𝓝 a) :=
begin
  have lim1 : map g (comap g (𝓝 d)) ≤ 𝓝 d := map_comap_le,
  replace lim1 : map h (map g (comap g (𝓝 d))) ≤ map h (𝓝 d) := map_mono lim1,
  rw [filter.map_map, comm, ← filter.map_map, map_le_iff_le_comap] at lim1,
  have lim2 :  comap i (map h (𝓝 d)) ≤  comap i  (𝓝 (i a)) := comap_mono H,
  rw ← di.nhds_eq_comap at lim2,
  exact le_trans lim1 lim2,
end

protected lemma nhds_within_ne_bot (di : dense_inducing i) (b : β) :
  ne_bot (𝓝[range i] b) :=
di.dense.nhds_within_ne_bot b

lemma comap_nhds_ne_bot (di : dense_inducing i) (b : β) : ne_bot (comap i (𝓝 b)) :=
comap_ne_bot $ λ s hs,
let ⟨_, ⟨ha, a, rfl⟩⟩ := mem_closure_iff_nhds.1 (di.dense b) s hs in ⟨a, ha⟩

variables [topological_space γ]

/-- If `i : α → β` is a dense inducing, then any function `f : α → γ` "extends"
  to a function `g = extend di f : β → γ`. If `γ` is Hausdorff and `f` has a
  continuous extension, then `g` is the unique such extension. In general,
  `g` might not be continuous or even extend `f`. -/
def extend (di : dense_inducing i) (f : α → γ) (b : β) : γ :=
@@lim _ ⟨f (di.dense.some b)⟩ (comap i (𝓝 b)) f

lemma extend_eq_of_tendsto [t2_space γ] {b : β} {c : γ} {f : α → γ}
  (hf : tendsto f (comap i (𝓝 b)) (𝓝 c)) :
  di.extend f b = c :=
by haveI := di.comap_nhds_ne_bot; exact hf.lim_eq

lemma extend_eq_at [t2_space γ] {f : α → γ} {a : α} (hf : continuous_at f a) :
  di.extend f (i a) = f a :=
extend_eq_of_tendsto _ $ di.nhds_eq_comap a ▸ hf

lemma extend_eq_at' [t2_space γ] {f : α → γ} {a : α} (c : γ) (hf : tendsto f (𝓝 a) (𝓝 c)) :
  di.extend f (i a) = f a :=
di.extend_eq_at (continuous_at_of_tendsto_nhds hf)

lemma extend_eq [t2_space γ] {f : α → γ} (hf : continuous f) (a : α) :
  di.extend f (i a) = f a :=
di.extend_eq_at hf.continuous_at

/-- Variation of `extend_eq` where we ask that `f` has a limit along `comap i (𝓝 b)` for each
`b : β`. This is a strictly stronger assumption than continuity of `f`, but in a lot of cases
you'd have to prove it anyway to use `continuous_extend`, so this avoids doing the work twice. -/
lemma extend_eq' [t2_space γ] {f : α → γ}
  (di : dense_inducing i) (hf : ∀ b, ∃ c, tendsto f (comap i (𝓝 b)) (𝓝 c)) (a : α) :
  di.extend f (i a) = f a :=
begin
  rcases hf (i a) with ⟨b, hb⟩,
  refine di.extend_eq_at' b _,
  rwa ← di.to_inducing.nhds_eq_comap at hb,
end

lemma extend_unique_at [t2_space γ] {b : β} {f : α → γ} {g : β → γ} (di : dense_inducing i)
  (hf : ∀ᶠ x in comap i (𝓝 b), g (i x) = f x) (hg : continuous_at g b) :
  di.extend f b = g b :=
begin
  refine di.extend_eq_of_tendsto (λ s hs, mem_map.2 _),
  suffices : ∀ᶠ (x : α) in comap i (𝓝 b), g (i x) ∈ s,
    from hf.mp (this.mono $ λ x hgx hfx, hfx ▸ hgx),
  clear hf f,
  refine eventually_comap.2 ((hg.eventually hs).mono _),
  rintros _ hxs x rfl,
  exact hxs
end

lemma extend_unique [t2_space γ] {f : α → γ} {g : β → γ} (di : dense_inducing i)
  (hf : ∀ x, g (i x) = f x) (hg : continuous g) :
  di.extend f = g :=
funext $ λ b, extend_unique_at di (eventually_of_forall hf) hg.continuous_at

lemma continuous_at_extend [t3_space γ] {b : β} {f : α → γ} (di : dense_inducing i)
  (hf : ∀ᶠ x in 𝓝 b, ∃c, tendsto f (comap i $ 𝓝 x) (𝓝 c)) :
  continuous_at (di.extend f) b :=
begin
  set φ := di.extend f,
  haveI := di.comap_nhds_ne_bot,
  suffices : ∀ V' ∈ 𝓝 (φ b), is_closed V' → φ ⁻¹' V' ∈ 𝓝 b,
    by simpa [continuous_at, (closed_nhds_basis _).tendsto_right_iff],
  intros V' V'_in V'_closed,
  set V₁ := {x | tendsto f (comap i $ 𝓝 x) (𝓝 $ φ x)},
  have V₁_in : V₁ ∈ 𝓝 b,
  { filter_upwards [hf],
    rintros x ⟨c, hc⟩,
    dsimp [V₁, φ],
    rwa di.extend_eq_of_tendsto hc },
  obtain ⟨V₂, V₂_in, V₂_op, hV₂⟩ : ∃ V₂ ∈ 𝓝 b, is_open V₂ ∧ ∀ x ∈ i ⁻¹' V₂, f x ∈ V',
  { simpa [and_assoc] using ((nhds_basis_opens' b).comap i).tendsto_left_iff.mp
                            (mem_of_mem_nhds V₁_in : b ∈ V₁) V' V'_in },
  suffices : ∀ x ∈ V₁ ∩ V₂, φ x ∈ V',
  { filter_upwards [inter_mem V₁_in V₂_in] using this, },
  rintros x ⟨x_in₁, x_in₂⟩,
  have hV₂x : V₂ ∈ 𝓝 x := is_open.mem_nhds V₂_op x_in₂,
  apply V'_closed.mem_of_tendsto x_in₁,
  use V₂,
  tauto,
end

lemma continuous_extend [t3_space γ] {f : α → γ} (di : dense_inducing i)
  (hf : ∀b, ∃c, tendsto f (comap i (𝓝 b)) (𝓝 c)) : continuous (di.extend f) :=
continuous_iff_continuous_at.mpr $ assume b, di.continuous_at_extend $ univ_mem' hf

lemma mk'
  (i : α → β)
  (c     : continuous i)
  (dense : ∀x, x ∈ closure (range i))
  (H     : ∀ (a:α) s ∈ 𝓝 a,
    ∃t ∈ 𝓝 (i a), ∀ b, i b ∈ t → b ∈ s) :
  dense_inducing i :=
{ induced := (induced_iff_nhds_eq i).2 $
    λ a, le_antisymm (tendsto_iff_comap.1 $ c.tendsto _) (by simpa [filter.le_def] using H a),
  dense := dense }
end dense_inducing

/-- A dense embedding is an embedding with dense image. -/
structure dense_embedding [topological_space α] [topological_space β] (e : α → β)
  extends dense_inducing e : Prop :=
(inj : function.injective e)

theorem dense_embedding.mk'
  [topological_space α] [topological_space β] (e : α → β)
  (c     : continuous e)
  (dense : dense_range e)
  (inj   : function.injective e)
  (H     : ∀ (a:α) s ∈ 𝓝 a,
    ∃t ∈ 𝓝 (e a), ∀ b, e b ∈ t → b ∈ s) :
  dense_embedding e :=
{ inj := inj,
  ..dense_inducing.mk' e c dense H}

namespace dense_embedding
open topological_space
variables [topological_space α] [topological_space β] [topological_space γ] [topological_space δ]
variables {e : α → β} (de : dense_embedding e)

lemma inj_iff {x y} : e x = e y ↔ x = y := de.inj.eq_iff

lemma to_embedding : embedding e :=
{ induced := de.induced,
  inj := de.inj }

/-- If the domain of a `dense_embedding` is a separable space, then so is its codomain. -/
protected lemma separable_space [separable_space α] : separable_space β :=
de.to_dense_inducing.separable_space

/-- The product of two dense embeddings is a dense embedding. -/
protected lemma prod {e₁ : α → β} {e₂ : γ → δ} (de₁ : dense_embedding e₁)
  (de₂ : dense_embedding e₂) :
  dense_embedding (λ(p : α × γ), (e₁ p.1, e₂ p.2)) :=
{ inj := assume ⟨x₁, x₂⟩ ⟨y₁, y₂⟩,
    by simp; exact assume h₁ h₂, ⟨de₁.inj h₁, de₂.inj h₂⟩,
  ..dense_inducing.prod de₁.to_dense_inducing de₂.to_dense_inducing }

/-- The dense embedding of a subtype inside its closure. -/
@[simps] def subtype_emb {α : Type*} (p : α → Prop) (e : α → β) (x : {x // p x}) :
  {x // x ∈ closure (e '' {x | p x})} :=
⟨e x, subset_closure $ mem_image_of_mem e x.prop⟩

protected lemma subtype (p : α → Prop) : dense_embedding (subtype_emb p e) :=
{ dense := dense_iff_closure_eq.2 $
    begin
      ext ⟨x, hx⟩,
      rw image_eq_range at hx,
      simpa [closure_subtype, ← range_comp, (∘)],
    end,
  inj := (de.inj.comp subtype.coe_injective).cod_restrict _,
  induced := (induced_iff_nhds_eq _).2 (assume ⟨x, hx⟩,
    by simp [subtype_emb, nhds_subtype_eq_comap, de.to_inducing.nhds_eq_comap, comap_comap, (∘)]) }

lemma dense_image {s : set α} : dense (e '' s) ↔ dense s :=
de.to_dense_inducing.dense_image

end dense_embedding

lemma dense_embedding_id {α : Type*} [topological_space α] : dense_embedding (id : α → α) :=
{ dense := dense_range_id,
  .. embedding_id }

lemma dense.dense_embedding_coe [topological_space α] {s : set α} (hs : dense s) :
  dense_embedding (coe : s → α) :=
{ dense := hs.dense_range_coe,
  .. embedding_subtype_coe }

lemma is_closed_property [topological_space β] {e : α → β} {p : β → Prop}
  (he : dense_range e) (hp : is_closed {x | p x}) (h : ∀a, p (e a)) :
  ∀b, p b :=
have univ ⊆ {b | p b},
  from calc univ = closure (range e) : he.closure_range.symm
    ... ⊆ closure {b | p b} : closure_mono $ range_subset_iff.mpr h
    ... = _ : hp.closure_eq,
assume b, this trivial

lemma is_closed_property2 [topological_space β] {e : α → β} {p : β → β → Prop}
  (he : dense_range e) (hp : is_closed {q:β×β | p q.1 q.2}) (h : ∀a₁ a₂, p (e a₁) (e a₂)) :
  ∀b₁ b₂, p b₁ b₂ :=
have ∀q:β×β, p q.1 q.2,
  from is_closed_property (he.prod_map he) hp $ λ _, h _ _,
assume b₁ b₂, this ⟨b₁, b₂⟩

lemma is_closed_property3 [topological_space β] {e : α → β} {p : β → β → β → Prop}
  (he : dense_range e) (hp : is_closed {q:β×β×β | p q.1 q.2.1 q.2.2})
  (h : ∀a₁ a₂ a₃, p (e a₁) (e a₂) (e a₃)) :
  ∀b₁ b₂ b₃, p b₁ b₂ b₃ :=
have ∀q:β×β×β, p q.1 q.2.1 q.2.2,
  from is_closed_property (he.prod_map $ he.prod_map he) hp $ λ _, h _ _ _,
assume b₁ b₂ b₃, this ⟨b₁, b₂, b₃⟩

@[elab_as_eliminator]
lemma dense_range.induction_on [topological_space β] {e : α → β} (he : dense_range e) {p : β → Prop}
  (b₀ : β) (hp : is_closed {b | p b}) (ih : ∀a:α, p $ e a) : p b₀ :=
is_closed_property he hp ih b₀

@[elab_as_eliminator]
lemma dense_range.induction_on₂ [topological_space β] {e : α → β} {p : β → β → Prop}
  (he : dense_range e) (hp : is_closed {q:β×β | p q.1 q.2}) (h : ∀a₁ a₂, p (e a₁) (e a₂))
  (b₁ b₂ : β) : p b₁ b₂ := is_closed_property2 he hp h _ _

@[elab_as_eliminator]
lemma dense_range.induction_on₃ [topological_space β] {e : α → β} {p : β → β → β → Prop}
  (he : dense_range e) (hp : is_closed {q:β×β×β | p q.1 q.2.1 q.2.2})
  (h : ∀a₁ a₂ a₃, p (e a₁) (e a₂) (e a₃))
  (b₁ b₂ b₃ : β) : p b₁ b₂ b₃ := is_closed_property3 he hp h _ _ _

section
variables [topological_space β] [topological_space γ] [t2_space γ]
variables {f : α → β}

/-- Two continuous functions to a t2-space that agree on the dense range of a function are equal. -/
lemma dense_range.equalizer (hfd : dense_range f)
  {g h : β → γ} (hg : continuous g) (hh : continuous h) (H : g ∘ f = h ∘ f) :
  g = h :=
funext $ λ y, hfd.induction_on y (is_closed_eq hg hh) $ congr_fun H
end

-- Bourbaki GT III §3 no.4 Proposition 7 (generalised to any dense-inducing map to a T₃ space)
lemma filter.has_basis.has_basis_of_dense_inducing
  [topological_space α] [topological_space β] [t3_space β]
  {ι : Type*} {s : ι → set α} {p : ι → Prop} {x : α} (h : (𝓝 x).has_basis p s)
  {f : α → β} (hf : dense_inducing f) :
  (𝓝 (f x)).has_basis p $ λ i, closure $ f '' (s i) :=
begin
  rw filter.has_basis_iff at h ⊢,
  intros T,
  refine ⟨λ hT, _, λ hT, _⟩,
  { obtain ⟨T', hT₁, hT₂, hT₃⟩ := exists_mem_nhds_is_closed_subset hT,
    have hT₄ : f⁻¹' T' ∈ 𝓝 x,
    { rw hf.to_inducing.nhds_eq_comap x,
      exact ⟨T', hT₁, subset.rfl⟩, },
    obtain ⟨i, hi, hi'⟩ := (h _).mp hT₄,
    exact ⟨i, hi, (closure_mono (image_subset f hi')).trans (subset.trans (closure_minimal
      (image_subset_iff.mpr subset.rfl) hT₂) hT₃)⟩, },
  { obtain ⟨i, hi, hi'⟩ := hT,
    suffices : closure (f '' s i) ∈ 𝓝 (f x), { filter_upwards [this] using hi', },
    replace h := (h (s i)).mpr ⟨i, hi, subset.rfl⟩,
    exact hf.closure_image_mem_nhds h, },
end


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

/-!
# Polynomial functors

This file defines polynomial functors and the W-type construction as a
polynomial functor.  (For the M-type construction, see
pfunctor/M.lean.)
-/

universe u

/--
A polynomial functor `P` is given by a type `A` and a family `B` of types over `A`. `P` maps
any type `α` to a new type `P.obj α`, which is defined as the sigma type `Σ x, P.B x → α`.

An element of `P.obj α` is a pair `⟨a, f⟩`, where `a` is an element of a type `A` and
`f : B a → α`. Think of `a` as the shape of the object and `f` as an index to the relevant
elements of `α`.
-/

structure pfunctor :=
(A : Type u) (B : A → Type u)

namespace pfunctor

instance : inhabited pfunctor :=
⟨⟨default _, default _⟩⟩

variables (P : pfunctor) {α β : Type u}

/-- Applying `P` to an object of `Type` -/
def obj (α : Type*) := Σ x : P.A, P.B x → α

/-- Applying `P` to a morphism of `Type` -/
def map {α β : Type*} (f : α → β) : P.obj α → P.obj β :=
λ ⟨a, g⟩, ⟨a, f ∘ g⟩

instance obj.inhabited [inhabited P.A] [inhabited α] : inhabited (P.obj α) :=
⟨ ⟨ default _, λ _, default _ ⟩ ⟩
instance : functor P.obj := {map := @map P}

protected theorem map_eq {α β : Type*} (f : α → β) (a : P.A) (g : P.B a → α) :
  @functor.map P.obj _ _ _ f ⟨a, g⟩ = ⟨a, f ∘ g⟩ :=
rfl

protected theorem id_map {α : Type*} : ∀ x : P.obj α, id <$> x = id x :=
λ ⟨a, b⟩, rfl

protected theorem comp_map {α β γ : Type*} (f : α → β) (g : β → γ) :
  ∀ x : P.obj α, (g ∘ f) <$> x = g <$> (f <$> x) :=
λ ⟨a, b⟩, rfl

instance : is_lawful_functor P.obj :=
{id_map := @pfunctor.id_map P, comp_map := @pfunctor.comp_map P}

/-- re-export existing definition of W-types and
adapt it to a packaged definition of polynomial functor -/
def W := _root_.W_type P.B

/- inhabitants of W types is awkward to encode as an instance
assumption because there needs to be a value `a : P.A`
such that `P.B a` is empty to yield a finite tree -/
attribute [nolint has_inhabited_instance] W
variables {P}

/-- root element  of a W tree -/
def W.head : W P → P.A
| ⟨a, f⟩ := a

/-- children of the root of a W tree -/
def W.children : Π x : W P, P.B (W.head x) → W P
| ⟨a, f⟩ := f

/-- destructor for W-types -/
def W.dest : W P → P.obj (W P)
| ⟨a, f⟩ := ⟨a, f⟩

/-- constructor for W-types -/
def W.mk : P.obj (W P) → W P
| ⟨a, f⟩ := ⟨a, f⟩

@[simp] theorem W.dest_mk (p : P.obj (W P)) : W.dest (W.mk p) = p :=
by cases p; reflexivity

@[simp] theorem W.mk_dest (p : W P) : W.mk (W.dest p) = p :=
by cases p; reflexivity

variables (P)

/-- `Idx` identifies a location inside the application of a pfunctor.
For `F : pfunctor`, `x : F.obj α` and `i : F.Idx`, `i` can designate
one part of `x` or is invalid, if `i.1 ≠ x.1` -/
def Idx := Σ x : P.A, P.B x

instance Idx.inhabited [inhabited P.A] [inhabited (P.B (default _))] : inhabited P.Idx :=
⟨ ⟨default _, default _⟩ ⟩

variables {P}

/-- `x.iget i` takes the component of `x` designated by `i` if any is or returns
a default value -/
def obj.iget [decidable_eq P.A] {α} [inhabited α] (x : P.obj α) (i : P.Idx) : α :=
if h : i.1 = x.1
  then x.2 (cast (congr_arg _ h) i.2)
  else default _

@[simp]
lemma fst_map {α β : Type u} (x : P.obj α) (f : α → β) :
  (f <$> x).1 = x.1 := by { cases x; refl }

@[simp]
lemma iget_map [decidable_eq P.A] {α β : Type u} [inhabited α] [inhabited β]
  (x : P.obj α) (f : α → β) (i : P.Idx)
  (h : i.1 = x.1) :
  (f <$> x).iget i = f (x.iget i) :=
by { simp only [obj.iget, fst_map, *, dif_pos, eq_self_iff_true],
     cases x, refl }

end pfunctor

/-
Composition of polynomial functors.
-/

namespace pfunctor

/-- functor composition for polynomial functors -/
def comp (P₂ P₁ : pfunctor.{u}) : pfunctor.{u} :=
⟨ Σ a₂ : P₂.1, P₂.2 a₂ → P₁.1,
  λ a₂a₁, Σ u : P₂.2 a₂a₁.1, P₁.2 (a₂a₁.2 u) ⟩

/-- constructor for composition -/
def comp.mk (P₂ P₁ : pfunctor.{u}) {α : Type} (x : P₂.obj (P₁.obj α)) : (comp P₂ P₁).obj α :=
⟨ ⟨ x.1, sigma.fst ∘ x.2 ⟩, λ a₂a₁, (x.2 a₂a₁.1).2 a₂a₁.2  ⟩

/-- destructor for composition -/
def comp.get (P₂ P₁ : pfunctor.{u}) {α : Type} (x : (comp P₂ P₁).obj α) : P₂.obj (P₁.obj α) :=
⟨ x.1.1, λ a₂, ⟨x.1.2 a₂, λ a₁, x.2 ⟨a₂,a₁⟩ ⟩ ⟩

end pfunctor

/-
Lifting predicates and relations.
-/

namespace pfunctor
variables {P : pfunctor.{u}}
open functor

theorem liftp_iff {α : Type u} (p : α → Prop) (x : P.obj α) :
  liftp p x ↔ ∃ a f, x = ⟨a, f⟩ ∧ ∀ i, p (f i) :=
begin
  split,
  { rintros ⟨y, hy⟩, cases h : y with a f,
    refine ⟨a, λ i, (f i).val, _, λ i, (f i).property⟩,
    rw [←hy, h, pfunctor.map_eq] },
  rintros ⟨a, f, xeq, pf⟩,
  use ⟨a, λ i, ⟨f i, pf i⟩⟩,
  rw [xeq], reflexivity
end

theorem liftp_iff' {α : Type u} (p : α → Prop) (a : P.A) (f : P.B a → α) :
  @liftp.{u} P.obj _ α p ⟨a,f⟩ ↔ ∀ i, p (f i) :=
begin
  simp only [liftp_iff, sigma.mk.inj_iff]; split; intro,
  { casesm* [Exists _, _ ∧ _], subst_vars, assumption },
  repeat { constructor <|> assumption }
end

theorem liftr_iff {α : Type u} (r : α → α → Prop) (x y : P.obj α) :
  liftr r x y ↔ ∃ a f₀ f₁, x = ⟨a, f₀⟩ ∧ y = ⟨a, f₁⟩ ∧ ∀ i, r (f₀ i) (f₁ i) :=
begin
  split,
  { rintros ⟨u, xeq, yeq⟩, cases h : u with a f,
    use [a, λ i, (f i).val.fst, λ i, (f i).val.snd],
    split, { rw [←xeq, h], refl },
    split, { rw [←yeq, h], refl },
    intro i, exact (f i).property },
  rintros ⟨a, f₀, f₁, xeq, yeq, h⟩,
  use ⟨a, λ i, ⟨(f₀ i, f₁ i), h i⟩⟩,
  split,
  { rw [xeq], refl },
  rw [yeq], refl
end

open set

theorem supp_eq {α : Type u} (a : P.A) (f : P.B a → α) :
  @supp.{u} P.obj _ α  (⟨a,f⟩ : P.obj α) = f '' univ :=
begin
  ext, simp only [supp, image_univ, mem_range, mem_set_of_eq],
  split; intro h,
  { apply @h (λ x, ∃ (y : P.B a), f y = x),
    rw liftp_iff', intro, refine ⟨_,rfl⟩ },
  { simp only [liftp_iff'], cases h, subst x,
    tauto }
end

end pfunctor


/-
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, Alexander Bentkamp
-/
import algebra.big_operators.finsupp
import algebra.big_operators.finprod
import data.fintype.big_operators
import linear_algebra.finsupp
import linear_algebra.linear_independent
import linear_algebra.linear_pmap
import linear_algebra.projection

/-!

# Bases

> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
> Any changes to this file require a corresponding PR to mathlib4.

This file defines bases in a module or vector space.

It is inspired by Isabelle/HOL's linear algebra, and hence indirectly by HOL Light.

## Main definitions

All definitions are given for families of vectors, i.e. `v : ι → M` where `M` is the module or
vector space and `ι : Type*` is an arbitrary indexing type.

* `basis ι R M` is the type of `ι`-indexed `R`-bases for a module `M`,
  represented by a linear equiv `M ≃ₗ[R] ι →₀ R`.
* the basis vectors of a basis `b : basis ι R M` are available as `b i`, where `i : ι`

* `basis.repr` is the isomorphism sending `x : M` to its coordinates `basis.repr x : ι →₀ R`.
  The converse, turning this isomorphism into a basis, is called `basis.of_repr`.
* If `ι` is finite, there is a variant of `repr` called `basis.equiv_fun b : M ≃ₗ[R] ι → R`
  (saving you from having to work with `finsupp`). The converse, turning this isomorphism into
  a basis, is called `basis.of_equiv_fun`.

* `basis.constr hv f` constructs a linear map `M₁ →ₗ[R] M₂` given the values `f : ι → M₂` at the
  basis elements `⇑b : ι → M₁`.
* `basis.reindex` uses an equiv to map a basis to a different indexing set.
* `basis.map` uses a linear equiv to map a basis to a different module.

## Main statements

* `basis.mk`: a linear independent set of vectors spanning the whole module determines a basis

* `basis.ext` states that two linear maps are equal if they coincide on a basis.
  Similar results are available for linear equivs (if they coincide on the basis vectors),
  elements (if their coordinates coincide) and the functions `b.repr` and `⇑b`.

* `basis.of_vector_space` states that every vector space has a basis.

## Implementation notes

We use families instead of sets because it allows us to say that two identical vectors are linearly
dependent. For bases, this is useful as well because we can easily derive ordered bases by using an
ordered index type `ι`.

## Tags

basis, bases

-/

noncomputable theory

universe u

open function set submodule
open_locale big_operators

variables {ι : Type*} {ι' : Type*} {R : Type*} {R₂ : Type*} {K : Type*}
variables {M : Type*} {M' M'' : Type*} {V : Type u} {V' : Type*}

section module

variables [semiring R]
variables [add_comm_monoid M] [module R M] [add_comm_monoid M'] [module R M']

section
variables (ι) (R) (M)

/-- A `basis ι R M` for a module `M` is the type of `ι`-indexed `R`-bases of `M`.

The basis vectors are available as `coe_fn (b : basis ι R M) : ι → M`.
To turn a linear independent family of vectors spanning `M` into a basis, use `basis.mk`.
They are internally represented as linear equivs `M ≃ₗ[R] (ι →₀ R)`,
available as `basis.repr`.
-/
structure basis := of_repr :: (repr : M ≃ₗ[R] (ι →₀ R))

end

instance unique_basis [subsingleton R] : unique (basis ι R M) :=
⟨⟨⟨default⟩⟩, λ ⟨b⟩, by rw subsingleton.elim b⟩

namespace basis

instance : inhabited (basis ι R (ι →₀ R)) := ⟨basis.of_repr (linear_equiv.refl _ _)⟩

variables (b b₁ : basis ι R M) (i : ι) (c : R) (x : M)

section repr

lemma repr_injective : injective (repr : basis ι R M → M ≃ₗ[R] (ι →₀ R)) :=
λ f g h, by cases f; cases g; congr'

/-- `b i` is the `i`th basis vector. -/
instance fun_like : fun_like (basis ι R M) ι (λ _, M) :=
{ coe := λ b i, b.repr.symm (finsupp.single i 1),
  coe_injective' := λ f g h, repr_injective $ linear_equiv.symm_bijective.injective begin
    ext x,
    rw [←finsupp.sum_single x, map_finsupp_sum, map_finsupp_sum],
    congr' with i r,
    have := congr_fun h i,
    dsimp at this,
    rw [←mul_one r, ←finsupp.smul_single', linear_equiv.map_smul, linear_equiv.map_smul, this],
  end }

@[simp] lemma coe_of_repr (e : M ≃ₗ[R] (ι →₀ R)) :
  ⇑(of_repr e) = λ i, e.symm (finsupp.single i 1) :=
rfl

protected lemma injective [nontrivial R] : injective b :=
b.repr.symm.injective.comp (λ _ _, (finsupp.single_left_inj (one_ne_zero : (1 : R) ≠ 0)).mp)

lemma repr_symm_single_one : b.repr.symm (finsupp.single i 1) = b i := rfl

lemma repr_symm_single : b.repr.symm (finsupp.single i c) = c • b i :=
calc b.repr.symm (finsupp.single i c)
    = b.repr.symm (c • finsupp.single i 1) : by rw [finsupp.smul_single', mul_one]
... = c • b i : by rw [linear_equiv.map_smul, repr_symm_single_one]

@[simp] lemma repr_self : b.repr (b i) = finsupp.single i 1 :=
linear_equiv.apply_symm_apply _ _

lemma repr_self_apply (j) [decidable (i = j)] :
  b.repr (b i) j = if i = j then 1 else 0 :=
by rw [repr_self, finsupp.single_apply]

@[simp] lemma repr_symm_apply (v) : b.repr.symm v = finsupp.total ι M R b v :=
calc b.repr.symm v = b.repr.symm (v.sum finsupp.single) : by simp
... = ∑ i in v.support, b.repr.symm (finsupp.single i (v i)) :
  by rw [finsupp.sum, linear_equiv.map_sum]
... = finsupp.total ι M R b v :
  by simp [repr_symm_single, finsupp.total_apply, finsupp.sum]

@[simp] lemma coe_repr_symm : ↑b.repr.symm = finsupp.total ι M R b :=
linear_map.ext (λ v, b.repr_symm_apply v)

@[simp] lemma repr_total (v) : b.repr (finsupp.total _ _ _ b v) = v :=
by { rw ← b.coe_repr_symm, exact b.repr.apply_symm_apply v }

@[simp] lemma total_repr : finsupp.total _ _ _ b (b.repr x) = x :=
by { rw ← b.coe_repr_symm, exact b.repr.symm_apply_apply x }

lemma repr_range : (b.repr : M →ₗ[R] (ι →₀ R)).range = finsupp.supported R R univ :=
by rw [linear_equiv.range, finsupp.supported_univ]

lemma mem_span_repr_support {ι : Type*} (b : basis ι R M) (m : M) :
  m ∈ span R (b '' (b.repr m).support) :=
(finsupp.mem_span_image_iff_total _).2 ⟨b.repr m, (by simp [finsupp.mem_supported_support])⟩

lemma repr_support_subset_of_mem_span {ι : Type*}
  (b : basis ι R M) (s : set ι) {m : M} (hm : m ∈ span R (b '' s)) : ↑(b.repr m).support ⊆ s :=
begin
  rcases (finsupp.mem_span_image_iff_total _).1 hm with ⟨l, hl, hlm⟩,
  rwa [←hlm, repr_total, ←finsupp.mem_supported R l]
end

end repr

section coord

/-- `b.coord i` is the linear function giving the `i`'th coordinate of a vector
with respect to the basis `b`.

`b.coord i` is an element of the dual space. In particular, for
finite-dimensional spaces it is the `ι`th basis vector of the dual space.
-/
@[simps]
def coord : M →ₗ[R] R := (finsupp.lapply i) ∘ₗ ↑b.repr

lemma forall_coord_eq_zero_iff {x : M} :
  (∀ i, b.coord i x = 0) ↔ x = 0 :=
iff.trans
  (by simp only [b.coord_apply, finsupp.ext_iff, finsupp.zero_apply])
  b.repr.map_eq_zero_iff

/-- The sum of the coordinates of an element `m : M` with respect to a basis. -/
noncomputable def sum_coords : M →ₗ[R] R :=
finsupp.lsum ℕ (λ i, linear_map.id) ∘ₗ (b.repr : M →ₗ[R] ι →₀ R)

@[simp] lemma coe_sum_coords : (b.sum_coords : M → R) = λ m, (b.repr m).sum (λ i, id) :=
rfl

lemma coe_sum_coords_eq_finsum : (b.sum_coords : M → R) = λ m, ∑ᶠ i, b.coord i m :=
begin
  ext m,
  simp only [basis.sum_coords, basis.coord, finsupp.lapply_apply, linear_map.id_coe,
    linear_equiv.coe_coe, function.comp_app, finsupp.coe_lsum, linear_map.coe_comp,
    finsum_eq_sum _ (b.repr m).finite_support, finsupp.sum, finset.finite_to_set_to_finset,
    id.def, finsupp.fun_support_eq],
end

@[simp] lemma coe_sum_coords_of_fintype [fintype ι] : (b.sum_coords : M → R) = ∑ i, b.coord i :=
begin
  ext m,
  simp only [sum_coords, finsupp.sum_fintype, linear_map.id_coe, linear_equiv.coe_coe, coord_apply,
    id.def, fintype.sum_apply, implies_true_iff, eq_self_iff_true, finsupp.coe_lsum,
    linear_map.coe_comp],
end

@[simp] lemma sum_coords_self_apply : b.sum_coords (b i) = 1 :=
by simp only [basis.sum_coords, linear_map.id_coe, linear_equiv.coe_coe, id.def, basis.repr_self,
  function.comp_app, finsupp.coe_lsum, linear_map.coe_comp, finsupp.sum_single_index]

lemma dvd_coord_smul (i : ι) (m : M) (r : R) : r ∣ b.coord i (r • m) :=
⟨b.coord i m, by simp⟩

lemma coord_repr_symm (b : basis ι R M) (i : ι) (f : ι →₀  R) :
  b.coord i (b.repr.symm f) = f i :=
by simp only [repr_symm_apply, coord_apply, repr_total]

end coord

section ext

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

/-- Two linear maps are equal if they are equal on basis vectors. -/
theorem ext {f₁ f₂ : M →ₛₗ[σ] M₁} (h : ∀ i, f₁ (b i) = f₂ (b i)) : f₁ = f₂ :=
by { ext x,
     rw [← b.total_repr x, finsupp.total_apply, finsupp.sum],
     simp only [linear_map.map_sum, linear_map.map_smulₛₗ, h] }

include σ'

/-- Two linear equivs are equal if they are equal on basis vectors. -/
theorem ext' {f₁ f₂ : M ≃ₛₗ[σ] M₁} (h : ∀ i, f₁ (b i) = f₂ (b i)) : f₁ = f₂ :=
by { ext x,
      rw [← b.total_repr x, finsupp.total_apply, finsupp.sum],
      simp only [linear_equiv.map_sum, linear_equiv.map_smulₛₗ, h] }

omit σ'

/-- Two elements are equal iff their coordinates are equal. -/
lemma ext_elem_iff {x y : M} :
   x = y ↔ (∀ i, b.repr x i = b.repr y i) :=
by simp only [← finsupp.ext_iff, embedding_like.apply_eq_iff_eq]

alias ext_elem_iff ↔ _ _root_.basis.ext_elem

lemma repr_eq_iff {b : basis ι R M} {f : M →ₗ[R] ι →₀ R} :
  ↑b.repr = f ↔ ∀ i, f (b i) = finsupp.single i 1 :=
⟨λ h i, h ▸ b.repr_self i,
 λ h, b.ext (λ i, (b.repr_self i).trans (h i).symm)⟩

lemma repr_eq_iff' {b : basis ι R M} {f : M ≃ₗ[R] ι →₀ R} :
  b.repr = f ↔ ∀ i, f (b i) = finsupp.single i 1 :=
⟨λ h i, h ▸ b.repr_self i,
  λ h, b.ext' (λ i, (b.repr_self i).trans (h i).symm)⟩

lemma apply_eq_iff {b : basis ι R M} {x : M} {i : ι} :
  b i = x ↔ b.repr x = finsupp.single i 1 :=
⟨λ h, h ▸ b.repr_self i,
 λ h, b.repr.injective ((b.repr_self i).trans h.symm)⟩

/-- An unbundled version of `repr_eq_iff` -/
lemma repr_apply_eq (f : M → ι → R)
  (hadd : ∀ x y, f (x + y) = f x + f y) (hsmul : ∀ (c : R) (x : M), f (c • x) = c • f x)
  (f_eq : ∀ i, f (b i) = finsupp.single i 1) (x : M) (i : ι) :
  b.repr x i = f x i :=
begin
  let f_i : M →ₗ[R] R :=
  { to_fun := λ x, f x i,
    map_add' := λ _ _, by rw [hadd, pi.add_apply],
    map_smul' := λ _ _, by { simp [hsmul, pi.smul_apply] } },
  have : (finsupp.lapply i) ∘ₗ ↑b.repr = f_i,
  { refine b.ext (λ j, _),
    show b.repr (b j) i = f (b j) i,
    rw [b.repr_self, f_eq] },
  calc b.repr x i = f_i x : by { rw ← this, refl }
              ... = f x i : rfl
end

/-- Two bases are equal if they assign the same coordinates. -/
lemma eq_of_repr_eq_repr {b₁ b₂ : basis ι R M} (h : ∀ x i, b₁.repr x i = b₂.repr x i) : b₁ = b₂ :=
repr_injective $ by { ext, apply h }

/-- Two bases are equal if their basis vectors are the same. -/
@[ext] lemma eq_of_apply_eq {b₁ b₂ : basis ι R M} : (∀ i, b₁ i = b₂ i) → b₁ = b₂ := fun_like.ext _ _

end ext

section map

variables (f : M ≃ₗ[R] M')

/-- Apply the linear equivalence `f` to the basis vectors. -/
@[simps] protected def map : basis ι R M' :=
of_repr (f.symm.trans b.repr)

@[simp] lemma map_apply (i) : b.map f i = f (b i) := rfl

end map

section map_coeffs

variables {R' : Type*} [semiring R'] [module R' M] (f : R ≃+* R') (h : ∀ c (x : M), f c • x = c • x)

include f h b

local attribute [instance] has_smul.comp.is_scalar_tower

/-- If `R` and `R'` are isomorphic rings that act identically on a module `M`,
then a basis for `M` as `R`-module is also a basis for `M` as `R'`-module.

See also `basis.algebra_map_coeffs` for the case where `f` is equal to `algebra_map`.
-/
@[simps {simp_rhs := tt}]
def map_coeffs : basis ι R' M :=
begin
  letI : module R' R := module.comp_hom R (↑f.symm : R' →+* R),
  haveI : is_scalar_tower R' R M :=
  { smul_assoc := λ x y z, begin dsimp [(•)],  rw [mul_smul, ←h, f.apply_symm_apply], end },
  exact (of_repr $ (b.repr.restrict_scalars R').trans $
    finsupp.map_range.linear_equiv (module.comp_hom.to_linear_equiv f.symm).symm )
end

lemma map_coeffs_apply (i : ι) : b.map_coeffs f h i = b i :=
apply_eq_iff.mpr $ by simp [f.to_add_equiv_eq_coe]

@[simp] lemma coe_map_coeffs : (b.map_coeffs f h : ι → M) = b :=
funext $ b.map_coeffs_apply f h

end map_coeffs

section reindex

variables (b' : basis ι' R M')
variables (e : ι ≃ ι')

/-- `b.reindex (e : ι ≃ ι')` is a basis indexed by `ι'` -/
def reindex : basis ι' R M :=
basis.of_repr (b.repr.trans (finsupp.dom_lcongr e))

lemma reindex_apply (i' : ι') : b.reindex e i' = b (e.symm i') :=
show (b.repr.trans (finsupp.dom_lcongr e)).symm (finsupp.single i' 1) =
  b.repr.symm (finsupp.single (e.symm i') 1),
by rw [linear_equiv.symm_trans_apply, finsupp.dom_lcongr_symm, finsupp.dom_lcongr_single]

@[simp] lemma coe_reindex : (b.reindex e : ι' → M) = b ∘ e.symm :=
funext (b.reindex_apply e)

lemma repr_reindex_apply (i' : ι') : (b.reindex e).repr x i' = b.repr x (e.symm i') :=
show (finsupp.dom_lcongr e : _ ≃ₗ[R] _) (b.repr x) i' = _, by simp

@[simp] lemma repr_reindex : (b.reindex e).repr x = (b.repr x).map_domain e :=
fun_like.ext _ _ $ by simp [repr_reindex_apply]

@[simp] lemma reindex_refl : b.reindex (equiv.refl ι) = b :=
eq_of_apply_eq $ λ i, by simp

/-- `simp` can prove this as `basis.coe_reindex` + `equiv_like.range_comp` -/
lemma range_reindex : set.range (b.reindex e) = set.range b :=
by rw [coe_reindex, equiv_like.range_comp]

@[simp] lemma sum_coords_reindex : (b.reindex e).sum_coords = b.sum_coords :=
begin
  ext x,
  simp only [coe_sum_coords, repr_reindex],
  exact finsupp.sum_map_domain_index (λ _, rfl) (λ _ _ _, rfl),
end

/-- `b.reindex_range` is a basis indexed by `range b`, the basis vectors themselves. -/
def reindex_range : basis (range b) R M :=
by haveI := classical.dec (nontrivial R); exact
if h : nontrivial R then
  by letI := h; exact b.reindex (equiv.of_injective b (basis.injective b))
else
  by letI : subsingleton R := not_nontrivial_iff_subsingleton.mp h; exact
    basis.of_repr (module.subsingleton_equiv R M (range b))

lemma reindex_range_self (i : ι) (h := set.mem_range_self i) :
  b.reindex_range ⟨b i, h⟩ = b i :=
begin
  by_cases htr : nontrivial R,
  { letI := htr,
    simp [htr, reindex_range, reindex_apply, equiv.apply_of_injective_symm b.injective,
      subtype.coe_mk] },
  { letI : subsingleton R := not_nontrivial_iff_subsingleton.mp htr,
    letI := module.subsingleton R M,
    simp [reindex_range] }
end

lemma reindex_range_repr_self (i : ι) :
  b.reindex_range.repr (b i) = finsupp.single ⟨b i, mem_range_self i⟩ 1 :=
calc b.reindex_range.repr (b i) = b.reindex_range.repr (b.reindex_range ⟨b i, mem_range_self i⟩) :
  congr_arg _ (b.reindex_range_self _ _).symm
... = finsupp.single ⟨b i, mem_range_self i⟩ 1 : b.reindex_range.repr_self _

@[simp] lemma reindex_range_apply (x : range b) : b.reindex_range x = x :=
by { rcases x with ⟨bi, ⟨i, rfl⟩⟩, exact b.reindex_range_self i, }

lemma reindex_range_repr' (x : M) {bi : M} {i : ι} (h : b i = bi) :
  b.reindex_range.repr x ⟨bi, ⟨i, h⟩⟩ = b.repr x i :=
begin
  nontriviality,
  subst h,
  refine (b.repr_apply_eq (λ x i, b.reindex_range.repr x ⟨b i, _⟩) _ _ _ x i).symm,
  { intros x y,
    ext i,
    simp only [pi.add_apply, linear_equiv.map_add, finsupp.coe_add] },
  { intros c x,
    ext i,
    simp only [pi.smul_apply, linear_equiv.map_smul, finsupp.coe_smul] },
  { intros i,
    ext j,
    simp only [reindex_range_repr_self],
    refine @finsupp.single_apply_left _ _ _ _ (λ i, (⟨b i, _⟩ : set.range b)) _ _ _ _,
    exact λ i j h, b.injective (subtype.mk.inj h) }
end

@[simp] lemma reindex_range_repr (x : M) (i : ι) (h := set.mem_range_self i) :
  b.reindex_range.repr x ⟨b i, h⟩ = b.repr x i :=
b.reindex_range_repr' _ rfl

section fintype

variables [fintype ι] [decidable_eq M]

/-- `b.reindex_finset_range` is a basis indexed by `finset.univ.image b`,
the finite set of basis vectors themselves. -/
def reindex_finset_range : basis (finset.univ.image b) R M :=
b.reindex_range.reindex ((equiv.refl M).subtype_equiv (by simp))

lemma reindex_finset_range_self (i : ι) (h := finset.mem_image_of_mem b (finset.mem_univ i)) :
  b.reindex_finset_range ⟨b i, h⟩ = b i :=
by { rw [reindex_finset_range, reindex_apply, reindex_range_apply], refl }

@[simp] lemma reindex_finset_range_apply (x : finset.univ.image b) :
  b.reindex_finset_range x = x :=
by { rcases x with ⟨bi, hbi⟩, rcases finset.mem_image.mp hbi with ⟨i, -, rfl⟩,
     exact b.reindex_finset_range_self i }

lemma reindex_finset_range_repr_self (i : ι) :
  b.reindex_finset_range.repr (b i) =
    finsupp.single ⟨b i, finset.mem_image_of_mem b (finset.mem_univ i)⟩ 1 :=
begin
  ext ⟨bi, hbi⟩,
  rw [reindex_finset_range, repr_reindex, finsupp.map_domain_equiv_apply, reindex_range_repr_self],
  convert finsupp.single_apply_left ((equiv.refl M).subtype_equiv _).symm.injective _ _ _,
  refl
end

@[simp] lemma reindex_finset_range_repr (x : M) (i : ι)
  (h := finset.mem_image_of_mem b (finset.mem_univ i)) :
  b.reindex_finset_range.repr x ⟨b i, h⟩ = b.repr x i :=
by simp [reindex_finset_range]

end fintype

end reindex

protected lemma linear_independent : linear_independent R b :=
linear_independent_iff.mpr $ λ l hl,
calc l = b.repr (finsupp.total _ _ _ b l) : (b.repr_total l).symm
   ... = 0 : by rw [hl, linear_equiv.map_zero]

protected lemma ne_zero [nontrivial R] (i) : b i ≠ 0 :=
b.linear_independent.ne_zero i

protected lemma mem_span (x : M) : x ∈ span R (range b) :=
by { rw [← b.total_repr x, finsupp.total_apply, finsupp.sum],
     exact submodule.sum_mem _ (λ i hi, submodule.smul_mem _ _ (submodule.subset_span ⟨i, rfl⟩)) }

protected lemma span_eq : span R (range b) = ⊤ :=
eq_top_iff.mpr $ λ x _, b.mem_span x

lemma index_nonempty (b : basis ι R M) [nontrivial M] : nonempty ι :=
begin
  obtain ⟨x, y, ne⟩ : ∃ (x y : M), x ≠ y := nontrivial.exists_pair_ne,
  obtain ⟨i, _⟩ := not_forall.mp (mt b.ext_elem_iff.2 ne),
  exact ⟨i⟩
end

/-- If the submodule `P` has a basis, `x ∈ P` iff it is a linear combination of basis vectors. -/
lemma mem_submodule_iff {P : submodule R M} (b : basis ι R P) {x : M} :
  x ∈ P ↔ ∃ (c : ι →₀ R), x = finsupp.sum c (λ i x, x • b i) :=
begin
  conv_lhs { rw [← P.range_subtype, ← submodule.map_top, ← b.span_eq, submodule.map_span,
    ← set.range_comp, ← finsupp.range_total] },
  simpa only [@eq_comm _ x],
end

section constr

variables (S : Type*) [semiring S] [module S M']
variables [smul_comm_class R S M']

/-- Construct a linear map given the value at the basis.

This definition is parameterized over an extra `semiring S`,
such that `smul_comm_class R S M'` holds.
If `R` is commutative, you can set `S := R`; if `R` is not commutative,
you can recover an `add_equiv` by setting `S := ℕ`.
See library note [bundled maps over different rings].
-/
def constr : (ι → M') ≃ₗ[S] (M →ₗ[R] M') :=
{ to_fun := λ f, (finsupp.total M' M' R id).comp $ (finsupp.lmap_domain R R f) ∘ₗ ↑b.repr,
  inv_fun := λ f i, f (b i),
  left_inv := λ f, by { ext, simp },
  right_inv := λ f, by { refine b.ext (λ i, _), simp },
  map_add' := λ f g, by { refine b.ext (λ i, _), simp },
  map_smul' := λ c f, by { refine b.ext (λ i, _), simp } }

theorem constr_def (f : ι → M') :
  b.constr S f = (finsupp.total M' M' R id) ∘ₗ ((finsupp.lmap_domain R R f) ∘ₗ ↑b.repr) :=
rfl

theorem constr_apply (f : ι → M') (x : M) :
  b.constr S f x = (b.repr x).sum (λ b a, a • f b) :=
by { simp only [constr_def, linear_map.comp_apply, finsupp.lmap_domain_apply, finsupp.total_apply],
     rw finsupp.sum_map_domain_index; simp [add_smul] }

@[simp] lemma constr_basis (f : ι → M') (i : ι) :
  (b.constr S f : M → M') (b i) = f i :=
by simp [basis.constr_apply, b.repr_self]

lemma constr_eq {g : ι → M'} {f : M →ₗ[R] M'}
  (h : ∀i, g i = f (b i)) : b.constr S g = f :=
b.ext $ λ i, (b.constr_basis S g i).trans (h i)

lemma constr_self (f : M →ₗ[R] M') : b.constr S (λ i, f (b i)) = f :=
b.constr_eq S $ λ x, rfl

lemma constr_range [nonempty ι] {f : ι  → M'} :
  (b.constr S f).range = span R (range f) :=
by rw [b.constr_def S f, linear_map.range_comp, linear_map.range_comp, linear_equiv.range,
       ← finsupp.supported_univ, finsupp.lmap_domain_supported, ←set.image_univ,
       ← finsupp.span_image_eq_map_total, set.image_id]

@[simp]
lemma constr_comp (f : M' →ₗ[R] M') (v : ι → M') :
  b.constr S (f ∘ v) = f.comp (b.constr S v) :=
b.ext (λ i, by simp only [basis.constr_basis, linear_map.comp_apply])

end constr

section equiv

variables (b' : basis ι' R M') (e : ι ≃ ι')
variables [add_comm_monoid M''] [module R M'']

/-- If `b` is a basis for `M` and `b'` a basis for `M'`, and the index types are equivalent,
`b.equiv b' e` is a linear equivalence `M ≃ₗ[R] M'`, mapping `b i` to `b' (e i)`. -/
protected def equiv : M ≃ₗ[R] M' :=
b.repr.trans (b'.reindex e.symm).repr.symm

@[simp] lemma equiv_apply : b.equiv b' e (b i) = b' (e i) :=
by simp [basis.equiv]

@[simp] lemma equiv_refl :
  b.equiv b (equiv.refl ι) = linear_equiv.refl R M :=
b.ext' (λ i, by simp)

@[simp] lemma equiv_symm : (b.equiv b' e).symm = b'.equiv b e.symm :=
b'.ext' $ λ i, (b.equiv b' e).injective (by simp)

@[simp]

@[simp]
lemma map_equiv (b : basis ι R M) (b' : basis ι' R M') (e : ι ≃ ι') :
  b.map (b.equiv b' e) = b'.reindex e.symm :=
by { ext i, simp }

end equiv

section prod

variables (b' : basis ι' R M')

/-- `basis.prod` maps a `ι`-indexed basis for `M` and a `ι'`-indexed basis for `M'`
to a `ι ⊕ ι'`-index basis for `M × M'`.
For the specific case of `R × R`, see also `basis.fin_two_prod`. -/
protected def prod : basis (ι ⊕ ι') R (M × M') :=
of_repr ((b.repr.prod b'.repr).trans (finsupp.sum_finsupp_lequiv_prod_finsupp R).symm)

@[simp]
lemma prod_repr_inl (x) (i) : (b.prod b').repr x (sum.inl i) = b.repr x.1 i := rfl

@[simp]
lemma prod_repr_inr (x) (i) : (b.prod b').repr x (sum.inr i) = b'.repr x.2 i := rfl

lemma prod_apply_inl_fst (i) :
  (b.prod b' (sum.inl i)).1 = b i :=
b.repr.injective $ by
{ ext j,
  simp only [basis.prod, basis.coe_of_repr, linear_equiv.symm_trans_apply, linear_equiv.prod_symm,
      linear_equiv.prod_apply, b.repr.apply_symm_apply, linear_equiv.symm_symm, repr_self,
      equiv.to_fun_as_coe, finsupp.fst_sum_finsupp_lequiv_prod_finsupp],
  apply finsupp.single_apply_left sum.inl_injective }

lemma prod_apply_inr_fst (i) :
(b.prod b' (sum.inr i)).1 = 0 :=
b.repr.injective $ by
{ ext i,
  simp only [basis.prod, basis.coe_of_repr, linear_equiv.symm_trans_apply, linear_equiv.prod_symm,
      linear_equiv.prod_apply, b.repr.apply_symm_apply, linear_equiv.symm_symm, repr_self,
      equiv.to_fun_as_coe, finsupp.fst_sum_finsupp_lequiv_prod_finsupp, linear_equiv.map_zero,
      finsupp.zero_apply],
  apply finsupp.single_eq_of_ne sum.inr_ne_inl }

lemma prod_apply_inl_snd (i) :
  (b.prod b' (sum.inl i)).2 = 0 :=
b'.repr.injective $ by
{ ext j,
  simp only [basis.prod, basis.coe_of_repr, linear_equiv.symm_trans_apply, linear_equiv.prod_symm,
      linear_equiv.prod_apply, b'.repr.apply_symm_apply, linear_equiv.symm_symm, repr_self,
      equiv.to_fun_as_coe, finsupp.snd_sum_finsupp_lequiv_prod_finsupp, linear_equiv.map_zero,
      finsupp.zero_apply],
  apply finsupp.single_eq_of_ne sum.inl_ne_inr }

lemma prod_apply_inr_snd (i) :
(b.prod b' (sum.inr i)).2 = b' i :=
b'.repr.injective $ by
{ ext i,
  simp only [basis.prod, basis.coe_of_repr, linear_equiv.symm_trans_apply, linear_equiv.prod_symm,
      linear_equiv.prod_apply, b'.repr.apply_symm_apply, linear_equiv.symm_symm, repr_self,
      equiv.to_fun_as_coe, finsupp.snd_sum_finsupp_lequiv_prod_finsupp],
  apply finsupp.single_apply_left sum.inr_injective }

@[simp]
lemma prod_apply (i) :
  b.prod b' i = sum.elim (linear_map.inl R M M' ∘ b) (linear_map.inr R M M' ∘ b') i :=
by { ext; cases i; simp only [prod_apply_inl_fst, sum.elim_inl, linear_map.inl_apply,
                              prod_apply_inr_fst, sum.elim_inr, linear_map.inr_apply,
                              prod_apply_inl_snd, prod_apply_inr_snd, comp_app] }

end prod

section no_zero_smul_divisors

-- Can't be an instance because the basis can't be inferred.
protected lemma no_zero_smul_divisors [no_zero_divisors R] (b : basis ι R M) :
  no_zero_smul_divisors R M :=
⟨λ c x hcx, or_iff_not_imp_right.mpr (λ hx, begin
  rw [← b.total_repr x, ← linear_map.map_smul] at hcx,
  have := linear_independent_iff.mp b.linear_independent (c • b.repr x) hcx,
  rw smul_eq_zero at this,
  exact this.resolve_right (λ hr, hx (b.repr.map_eq_zero_iff.mp hr))
end)⟩

protected lemma smul_eq_zero [no_zero_divisors R] (b : basis ι R M) {c : R} {x : M} :
  c • x = 0 ↔ c = 0 ∨ x = 0 :=
@smul_eq_zero _ _ _ _ _ b.no_zero_smul_divisors _ _

lemma _root_.eq_bot_of_rank_eq_zero [no_zero_divisors R] (b : basis ι R M) (N : submodule R M)
  (rank_eq : ∀ {m : ℕ} (v : fin m → N),
    linear_independent R (coe ∘ v : fin m → M) → m = 0) :
  N = ⊥ :=
begin
  rw submodule.eq_bot_iff,
  intros x hx,
  contrapose! rank_eq with x_ne,
  refine ⟨1, λ _, ⟨x, hx⟩, _, one_ne_zero⟩,
  rw fintype.linear_independent_iff,
  rintros g sum_eq i,
  cases i,
  simp only [function.const_apply, fin.default_eq_zero, submodule.coe_mk, finset.univ_unique,
             function.comp_const, finset.sum_singleton] at sum_eq,
  convert (b.smul_eq_zero.mp sum_eq).resolve_right x_ne
end

end no_zero_smul_divisors

section singleton

/-- `basis.singleton ι R` is the basis sending the unique element of `ι` to `1 : R`. -/
protected def singleton (ι R : Type*) [unique ι] [semiring R] :
  basis ι R R :=
of_repr
{ to_fun := λ x, finsupp.single default x,
  inv_fun := λ f, f default,
  left_inv := λ x, by simp,
  right_inv := λ f, finsupp.unique_ext (by simp),
  map_add' := λ x y, by simp,
  map_smul' := λ c x, by simp }

@[simp] lemma singleton_apply (ι R : Type*) [unique ι] [semiring R] (i) :
  basis.singleton ι R i = 1 :=
apply_eq_iff.mpr (by simp [basis.singleton])

@[simp] lemma singleton_repr (ι R : Type*) [unique ι] [semiring R] (x i) :
  (basis.singleton ι R).repr x i = x :=
by simp [basis.singleton, unique.eq_default i]

lemma basis_singleton_iff
  {R M : Type*} [ring R] [nontrivial R] [add_comm_group M] [module R M] [no_zero_smul_divisors R M]
  (ι : Type*) [unique ι] :
  nonempty (basis ι R M) ↔ ∃ x ≠ 0, ∀ y : M, ∃ r : R, r • x = y :=
begin
  fsplit,
  { rintro ⟨b⟩,
    refine ⟨b default, b.linear_independent.ne_zero _, _⟩,
    simpa [span_singleton_eq_top_iff, set.range_unique] using b.span_eq },
  { rintro ⟨x, nz, w⟩,
    refine ⟨of_repr $ linear_equiv.symm
      { to_fun := λ f, f default • x,
        inv_fun := λ y, finsupp.single default (w y).some,
        left_inv := λ f, finsupp.unique_ext _,
        right_inv := λ y, _,
        map_add' := λ y z, _,
        map_smul' := λ c y, _ }⟩,
    { rw [finsupp.add_apply, add_smul] },
    { rw [finsupp.smul_apply, smul_assoc], simp },
    { refine smul_left_injective _ nz _,
      simp only [finsupp.single_eq_same],
      exact (w (f default • x)).some_spec },
    { simp only [finsupp.single_eq_same],
      exact (w y).some_spec } }
end

end singleton

section empty

variables (M)

/-- If `M` is a subsingleton and `ι` is empty, this is the unique `ι`-indexed basis for `M`. -/
protected def empty [subsingleton M] [is_empty ι] : basis ι R M :=
of_repr 0

instance empty_unique [subsingleton M] [is_empty ι] : unique (basis ι R M) :=
{ default := basis.empty M, uniq := λ ⟨x⟩, congr_arg of_repr $ subsingleton.elim _ _ }

end empty

end basis

section fintype

open basis
open fintype

variables [fintype ι] (b : basis ι R M)

/-- A module over `R` with a finite basis is linearly equivalent to functions from its basis to `R`.
-/
def basis.equiv_fun : M ≃ₗ[R] (ι → R) :=
linear_equiv.trans b.repr
  ({ to_fun := coe_fn,
     map_add' := finsupp.coe_add,
     map_smul' := finsupp.coe_smul,
     ..finsupp.equiv_fun_on_finite } : (ι →₀ R) ≃ₗ[R] (ι → R))

/-- A module over a finite ring that admits a finite basis is finite. -/
def module.fintype_of_fintype (b : basis ι R M) [fintype R] : fintype M :=
by haveI := classical.dec_eq ι; exact
  fintype.of_equiv _ b.equiv_fun.to_equiv.symm

theorem module.card_fintype (b : basis ι R M) [fintype R] [fintype M] :
  card M = (card R) ^ (card ι) :=
by classical; exact
calc card M = card (ι → R)    : card_congr b.equiv_fun.to_equiv
        ... = card R ^ card ι : card_fun

/-- Given a basis `v` indexed by `ι`, the canonical linear equivalence between `ι → R` and `M` maps
a function `x : ι → R` to the linear combination `∑_i x i • v i`. -/
@[simp] lemma basis.equiv_fun_symm_apply (x : ι → R) :
  b.equiv_fun.symm x = ∑ i, x i • b i :=
by simp [basis.equiv_fun, finsupp.total_apply, finsupp.sum_fintype]

@[simp]
lemma basis.equiv_fun_apply (u : M) : b.equiv_fun u = b.repr u := rfl

@[simp] lemma basis.map_equiv_fun (f : M ≃ₗ[R] M') :
  (b.map f).equiv_fun = f.symm.trans b.equiv_fun :=
rfl

lemma basis.sum_equiv_fun (u : M) : ∑ i, b.equiv_fun u i • b i = u :=
begin
  conv_rhs { rw ← b.total_repr u },
  simp [finsupp.total_apply, finsupp.sum_fintype, b.equiv_fun_apply]
end

lemma basis.sum_repr (u : M) : ∑ i, b.repr u i • b i = u :=
b.sum_equiv_fun u

@[simp]
lemma basis.equiv_fun_self [decidable_eq ι] (i j : ι) :
  b.equiv_fun (b i) j = if i = j then 1 else 0 :=
by { rw [b.equiv_fun_apply, b.repr_self_apply] }

lemma basis.repr_sum_self (c : ι → R) : ⇑(b.repr (∑ i, c i • b i)) = c :=
begin
  ext j,
  simp only [map_sum, linear_equiv.map_smul, repr_self, finsupp.smul_single, smul_eq_mul,
             mul_one, finset.sum_apply'],
  rw [finset.sum_eq_single j, finsupp.single_eq_same],
  { rintros i - hi, exact finsupp.single_eq_of_ne hi },
  { intros, have := finset.mem_univ j, contradiction }
end

/-- Define a basis by mapping each vector `x : M` to its coordinates `e x : ι → R`,
as long as `ι` is finite. -/
def basis.of_equiv_fun (e : M ≃ₗ[R] (ι → R)) : basis ι R M :=
basis.of_repr $ e.trans $ linear_equiv.symm $ finsupp.linear_equiv_fun_on_finite R R ι

@[simp] lemma basis.of_equiv_fun_repr_apply (e : M ≃ₗ[R] (ι → R)) (x : M) (i : ι) :
  (basis.of_equiv_fun e).repr x i = e x i := rfl

@[simp] lemma basis.coe_of_equiv_fun [decidable_eq ι] (e : M ≃ₗ[R] (ι → R)) :
  (basis.of_equiv_fun e : ι → M) = λ i, e.symm (function.update 0 i 1) :=
funext $ λ i, e.injective $ funext $ λ j,
  by simp [basis.of_equiv_fun, ←finsupp.single_eq_pi_single, finsupp.single_eq_update]

@[simp] lemma basis.of_equiv_fun_equiv_fun
  (v : basis ι R M) : basis.of_equiv_fun v.equiv_fun = v :=
begin
  classical,
  ext j,
  simp only [basis.equiv_fun_symm_apply, basis.coe_of_equiv_fun],
  simp_rw [function.update_apply, ite_smul],
  simp only [finset.mem_univ, if_true, pi.zero_apply, one_smul, finset.sum_ite_eq', zero_smul],
end

variables (S : Type*) [semiring S] [module S M']
variables [smul_comm_class R S M']

@[simp] theorem basis.constr_apply_fintype (f : ι → M') (x : M) :
  (b.constr S f : M → M') x = ∑ i, (b.equiv_fun x i) • f i :=
by simp [b.constr_apply, b.equiv_fun_apply, finsupp.sum_fintype]

/-- If the submodule `P` has a finite basis,
`x ∈ P` iff it is a linear combination of basis vectors. -/
lemma basis.mem_submodule_iff' {P : submodule R M} (b : basis ι R P) {x : M} :
  x ∈ P ↔ ∃ (c : ι → R), x = ∑ i, c i • b i :=
b.mem_submodule_iff.trans $ finsupp.equiv_fun_on_finite.exists_congr_left.trans $ exists_congr $
λ c, by simp [finsupp.sum_fintype]

lemma basis.coord_equiv_fun_symm (i : ι) (f : ι → R) : b.coord i (b.equiv_fun.symm f) = f i :=
b.coord_repr_symm i (finsupp.equiv_fun_on_finite.symm f)

end fintype

end module

section comm_semiring

namespace basis

variables [comm_semiring R]
variables [add_comm_monoid M] [module R M] [add_comm_monoid M'] [module R M']
variables (b : basis ι R M) (b' : basis ι' R M')

/-- If `b` is a basis for `M` and `b'` a basis for `M'`,
and `f`, `g` form a bijection between the basis vectors,
`b.equiv' b' f g hf hg hgf hfg` is a linear equivalence `M ≃ₗ[R] M'`, mapping `b i` to `f (b i)`.
-/
def equiv' (f : M → M') (g : M' → M)
  (hf : ∀ i, f (b i) ∈ range b') (hg : ∀ i, g (b' i) ∈ range b)
  (hgf : ∀i, g (f (b i)) = b i) (hfg : ∀i, f (g (b' i)) = b' i) :
  M ≃ₗ[R] M' :=
{ inv_fun := b'.constr R (g ∘ b'),
  left_inv :=
    have (b'.constr R (g ∘ b')).comp (b.constr R (f ∘ b)) = linear_map.id,
    from (b.ext $ λ i, exists.elim (hf i)
      (λ i' hi', by rw [linear_map.comp_apply, b.constr_basis, function.comp_apply, ← hi',
                        b'.constr_basis, function.comp_apply, hi', hgf, linear_map.id_apply])),
    λ x, congr_arg (λ (h : M →ₗ[R] M), h x) this,
  right_inv :=
    have (b.constr R (f ∘ b)).comp (b'.constr R (g ∘ b')) = linear_map.id,
    from (b'.ext $ λ i, exists.elim (hg i)
      (λ i' hi', by rw [linear_map.comp_apply, b'.constr_basis, function.comp_apply, ← hi',
                        b.constr_basis, function.comp_apply, hi', hfg, linear_map.id_apply])),
    λ x, congr_arg (λ (h : M' →ₗ[R] M'), h x) this,
  .. b.constr R (f ∘ b) }

@[simp] lemma equiv'_apply (f : M → M') (g : M' → M) (hf hg hgf hfg) (i : ι) :
  b.equiv' b' f g hf hg hgf hfg (b i) = f (b i) :=
b.constr_basis R _ _

@[simp] lemma equiv'_symm_apply (f : M → M') (g : M' → M) (hf hg hgf hfg) (i : ι') :
  (b.equiv' b' f g hf hg hgf hfg).symm (b' i) = g (b' i) :=
b'.constr_basis R _ _

lemma sum_repr_mul_repr {ι'} [fintype ι'] (b' : basis ι' R M) (x : M) (i : ι) :
  ∑ (j : ι'), b.repr (b' j) i * b'.repr x j = b.repr x i :=
begin
  conv_rhs { rw [← b'.sum_repr x] },
  simp_rw [linear_equiv.map_sum, linear_equiv.map_smul, finset.sum_apply'],
  refine finset.sum_congr rfl (λ j _, _),
  rw [finsupp.smul_apply, smul_eq_mul, mul_comm]
end

end basis

end comm_semiring

section module

open linear_map

variables {v : ι → M}
variables [ring R] [comm_ring R₂] [add_comm_group M] [add_comm_group M'] [add_comm_group M'']
variables [module R M] [module R₂ M] [module R M'] [module R M'']
variables {c d : R} {x y : M}
variables (b : basis ι R M)

namespace basis

/--
Any basis is a maximal linear independent set.
-/
lemma maximal [nontrivial R] (b : basis ι R M) : b.linear_independent.maximal :=
λ w hi h,
begin
  -- If `range w` is strictly bigger than `range b`,
  apply le_antisymm h,
  -- then choose some `x ∈ range w \ range b`,
  intros x p,
  by_contradiction q,
  -- and write it in terms of the basis.
  have e := b.total_repr x,
  -- This then expresses `x` as a linear combination
  -- of elements of `w` which are in the range of `b`,
  let u : ι ↪ w := ⟨λ i, ⟨b i, h ⟨i, rfl⟩⟩, λ i i' r,
    b.injective (by simpa only [subtype.mk_eq_mk] using r)⟩,
  have r : ∀ i, b i = u i := λ i, rfl,
  simp_rw [finsupp.total_apply, r] at e,
  change (b.repr x).sum (λ (i : ι) (a : R), (λ (x : w) (r : R), r • (x : M)) (u i) a) =
    ((⟨x, p⟩ : w) : M) at e,
  rw [←finsupp.sum_emb_domain, ←finsupp.total_apply] at e,
  -- Now we can contradict the linear independence of `hi`
  refine hi.total_ne_of_not_mem_support _ _ e,
  simp only [finset.mem_map, finsupp.support_emb_domain],
  rintro ⟨j, -, W⟩,
  simp only [embedding.coe_fn_mk, subtype.mk_eq_mk, ←r] at W,
  apply q ⟨j, W⟩,
end

section mk

variables (hli : linear_independent R v) (hsp : ⊤ ≤ span R (range v))

/-- A linear independent family of vectors spanning the whole module is a basis. -/
protected noncomputable def mk : basis ι R M :=
basis.of_repr
{ inv_fun := finsupp.total _ _ _ v,
  left_inv := λ x, hli.total_repr ⟨x, _⟩,
  right_inv := λ x, hli.repr_eq rfl,
  .. hli.repr.comp (linear_map.id.cod_restrict _ (λ h, hsp submodule.mem_top)) }

@[simp] lemma mk_repr :
  (basis.mk hli hsp).repr x = hli.repr ⟨x, hsp submodule.mem_top⟩ :=
rfl

lemma mk_apply (i : ι) : basis.mk hli hsp i = v i :=
show finsupp.total _ _ _ v _ = v i, by simp

@[simp] lemma coe_mk : ⇑(basis.mk hli hsp) = v :=
funext (mk_apply _ _)

variables {hli hsp}

/-- Given a basis, the `i`th element of the dual basis evaluates to 1 on the `i`th element of the
basis. -/
lemma mk_coord_apply_eq (i : ι) :
  (basis.mk hli hsp).coord i (v i) = 1 :=
show hli.repr ⟨v i, submodule.subset_span (mem_range_self i)⟩ i = 1,
by simp [hli.repr_eq_single i]

/-- Given a basis, the `i`th element of the dual basis evaluates to 0 on the `j`th element of the
basis if `j ≠ i`. -/
lemma mk_coord_apply_ne {i j : ι} (h : j ≠ i) :
  (basis.mk hli hsp).coord i (v j) = 0 :=
show hli.repr ⟨v j, submodule.subset_span (mem_range_self j)⟩ i = 0,
by simp [hli.repr_eq_single j, h]

/-- Given a basis, the `i`th element of the dual basis evaluates to the Kronecker delta on the
`j`th element of the basis. -/
lemma mk_coord_apply [decidable_eq ι] {i j : ι} :
  (basis.mk hli hsp).coord i (v j) = if j = i then 1 else 0 :=
begin
  cases eq_or_ne j i,
  { simp only [h, if_true, eq_self_iff_true, mk_coord_apply_eq i], },
  { simp only [h, if_false, mk_coord_apply_ne h], },
end

end mk

section span

variables (hli : linear_independent R v)

/-- A linear independent family of vectors is a basis for their span. -/
protected noncomputable def span : basis ι R (span R (range v)) :=
basis.mk (linear_independent_span hli) $
begin
  intros x _,
  have h₁ : (coe : span R (range v) → M) '' set.range (λ i, subtype.mk (v i) _) = range v,
  { rw ← set.range_comp,
    refl },
  have h₂ : map (submodule.subtype (span R (range v)))
    (span R (set.range (λ i, subtype.mk (v i) _))) = span R (range v),
  { rw [← span_image, submodule.coe_subtype, h₁] },
  have h₃ : (x : M) ∈ map (submodule.subtype (span R (range v)))
    (span R (set.range (λ i, subtype.mk (v i) _))),
  { rw h₂, apply subtype.mem x },
  rcases mem_map.1 h₃ with ⟨y, hy₁, hy₂⟩,
  have h_x_eq_y : x = y,
  { rw [subtype.ext_iff, ← hy₂], simp },
  rwa h_x_eq_y
end

protected lemma span_apply (i : ι) : (basis.span hli i : M) = v i :=
congr_arg (coe : span R (range v) → M) $ basis.mk_apply (linear_independent_span hli) _ i

end span

lemma group_smul_span_eq_top
  {G : Type*} [group G] [distrib_mul_action G R] [distrib_mul_action G M]
  [is_scalar_tower G R M] {v : ι → M} (hv : submodule.span R (set.range v) = ⊤) {w : ι → G} :
  submodule.span R (set.range (w • v)) = ⊤ :=
begin
  rw eq_top_iff,
  intros j hj,
  rw ← hv at hj,
  rw submodule.mem_span at hj ⊢,
  refine λ p hp, hj p (λ u hu, _),
  obtain ⟨i, rfl⟩ := hu,
  have : ((w i)⁻¹ • 1 : R) • w i • v i ∈ p := p.smul_mem ((w i)⁻¹ • 1 : R) (hp ⟨i, rfl⟩),
  rwa [smul_one_smul, inv_smul_smul] at this,
end

/-- Given a basis `v` and a map `w` such that for all `i`, `w i` are elements of a group,
`group_smul` provides the basis corresponding to `w • v`. -/
def group_smul {G : Type*} [group G] [distrib_mul_action G R] [distrib_mul_action G M]
  [is_scalar_tower G R M] [smul_comm_class G R M] (v : basis ι R M) (w : ι → G) :
  basis ι R M :=
@basis.mk ι R M (w • v) _ _ _
  (v.linear_independent.group_smul w) (group_smul_span_eq_top v.span_eq).ge

lemma group_smul_apply {G : Type*} [group G] [distrib_mul_action G R] [distrib_mul_action G M]
  [is_scalar_tower G R M] [smul_comm_class G R M] {v : basis ι R M} {w : ι → G} (i : ι) :
  v.group_smul w i = (w • v : ι → M) i :=
mk_apply
  (v.linear_independent.group_smul w) (group_smul_span_eq_top v.span_eq).ge i

lemma units_smul_span_eq_top {v : ι → M} (hv : submodule.span R (set.range v) = ⊤)
  {w : ι → Rˣ} : submodule.span R (set.range (w • v)) = ⊤ :=
group_smul_span_eq_top hv

/-- Given a basis `v` and a map `w` such that for all `i`, `w i` is a unit, `smul_of_is_unit`
provides the basis corresponding to `w • v`. -/
def units_smul (v : basis ι R M) (w : ι → Rˣ) :
  basis ι R M :=
@basis.mk ι R M (w • v) _ _ _
  (v.linear_independent.units_smul w) (units_smul_span_eq_top v.span_eq).ge

lemma units_smul_apply {v : basis ι R M} {w : ι → Rˣ} (i : ι) :
  v.units_smul w i = w i • v i :=
mk_apply
  (v.linear_independent.units_smul w) (units_smul_span_eq_top v.span_eq).ge i

@[simp] lemma coord_units_smul (e : basis ι R₂ M) (w : ι → R₂ˣ) (i : ι) :
  (e.units_smul w).coord i = (w i)⁻¹ • e.coord i :=
begin
  classical,
  apply e.ext,
  intros j,
  transitivity ((e.units_smul w).coord i) ((w j)⁻¹ • (e.units_smul w) j),
  { congr,
    simp [basis.units_smul, ← mul_smul], },
  simp only [basis.coord_apply, linear_map.smul_apply, basis.repr_self, units.smul_def,
    smul_hom_class.map_smul, finsupp.single_apply],
  split_ifs with h h,
  { simp [h] },
  { simp }
end

@[simp] lemma repr_units_smul (e : basis ι R₂ M) (w : ι → R₂ˣ) (v : M) (i : ι) :
  (e.units_smul w).repr v i = (w i)⁻¹ • e.repr v i :=
congr_arg (λ f : M →ₗ[R₂] R₂, f v) (e.coord_units_smul w i)

/-- A version of `smul_of_units` that uses `is_unit`. -/
def is_unit_smul (v : basis ι R M) {w : ι → R} (hw : ∀ i, is_unit (w i)):
  basis ι R M :=
units_smul v (λ i, (hw i).unit)

lemma is_unit_smul_apply {v : basis ι R M} {w : ι → R} (hw : ∀ i, is_unit (w i)) (i : ι) :
  v.is_unit_smul hw i = w i • v i :=
units_smul_apply i

section fin

/-- Let `b` be a basis for a submodule `N` of `M`. If `y : M` is linear independent of `N`
and `y` and `N` together span the whole of `M`, then there is a basis for `M`
whose basis vectors are given by `fin.cons y b`. -/
noncomputable def mk_fin_cons {n : ℕ} {N : submodule R M} (y : M) (b : basis (fin n) R N)
  (hli : ∀ (c : R) (x ∈ N), c • y + x = 0 → c = 0)
  (hsp : ∀ (z : M), ∃ (c : R), z + c • y ∈ N) :
  basis (fin (n + 1)) R M :=
have span_b : submodule.span R (set.range (N.subtype ∘ b)) = N,
{ rw [set.range_comp, submodule.span_image, b.span_eq, submodule.map_subtype_top] },
@basis.mk _ _ _ (fin.cons y (N.subtype ∘ b) : fin (n + 1) → M) _ _ _
  ((b.linear_independent.map' N.subtype (submodule.ker_subtype _)) .fin_cons' _ _ $
    by { rintros c ⟨x, hx⟩ hc, rw span_b at hx, exact hli c x hx hc })
  (λ x _, by { rw [fin.range_cons, submodule.mem_span_insert', span_b], exact hsp x })

@[simp] lemma coe_mk_fin_cons {n : ℕ} {N : submodule R M} (y : M) (b : basis (fin n) R N)
  (hli : ∀ (c : R) (x ∈ N), c • y + x = 0 → c = 0)
  (hsp : ∀ (z : M), ∃ (c : R), z + c • y ∈ N) :
  (mk_fin_cons y b hli hsp : fin (n + 1) → M) = fin.cons y (coe ∘ b) :=
coe_mk _ _

/-- Let `b` be a basis for a submodule `N ≤ O`. If `y ∈ O` is linear independent of `N`
and `y` and `N` together span the whole of `O`, then there is a basis for `O`
whose basis vectors are given by `fin.cons y b`. -/
noncomputable def mk_fin_cons_of_le {n : ℕ} {N O : submodule R M}
  (y : M) (yO : y ∈ O) (b : basis (fin n) R N) (hNO : N ≤ O)
  (hli : ∀ (c : R) (x ∈ N), c • y + x = 0 → c = 0)
  (hsp : ∀ (z ∈ O), ∃ (c : R), z + c • y ∈ N) :
  basis (fin (n + 1)) R O :=
mk_fin_cons ⟨y, yO⟩ (b.map (submodule.comap_subtype_equiv_of_le hNO).symm)
  (λ c x hc hx, hli c x (submodule.mem_comap.mp hc) (congr_arg coe hx))
  (λ z, hsp z z.2)

@[simp] lemma coe_mk_fin_cons_of_le {n : ℕ} {N O : submodule R M}
  (y : M) (yO : y ∈ O) (b : basis (fin n) R N) (hNO : N ≤ O)
  (hli : ∀ (c : R) (x ∈ N), c • y + x = 0 → c = 0)
  (hsp : ∀ (z ∈ O), ∃ (c : R), z + c • y ∈ N) :
  (mk_fin_cons_of_le y yO b hNO hli hsp : fin (n + 1) → O) =
    fin.cons ⟨y, yO⟩ (submodule.of_le hNO ∘ b) :=
coe_mk_fin_cons _ _ _ _

/-- The basis of `R × R` given by the two vectors `(1, 0)` and `(0, 1)`. -/
protected def fin_two_prod (R : Type*) [semiring R] : basis (fin 2) R (R × R) :=
basis.of_equiv_fun (linear_equiv.fin_two_arrow R R).symm

@[simp] lemma fin_two_prod_zero (R : Type*) [semiring R] : basis.fin_two_prod R 0 = (1, 0) :=
by simp [basis.fin_two_prod]

@[simp] lemma fin_two_prod_one (R : Type*) [semiring R] : basis.fin_two_prod R 1 = (0, 1) :=
by simp [basis.fin_two_prod]

@[simp] lemma coe_fin_two_prod_repr {R : Type*} [semiring R] (x : R × R) :
  ⇑((basis.fin_two_prod R).repr x) = ![x.fst, x.snd] :=
rfl

end fin

end basis

end module

section induction

variables [ring R] [is_domain R]
variables [add_comm_group M] [module R M] {b : ι → M}

/-- If `N` is a submodule with finite rank, do induction on adjoining a linear independent
element to a submodule. -/
def submodule.induction_on_rank_aux (b : basis ι R M) (P : submodule R M → Sort*)
  (ih : ∀ (N : submodule R M),
    (∀ (N' ≤ N) (x ∈ N), (∀ (c : R) (y ∈ N'), c • x + y = (0 : M) → c = 0) → P N') → P N)
  (n : ℕ) (N : submodule R M)
  (rank_le : ∀ {m : ℕ} (v : fin m → N),
    linear_independent R (coe ∘ v : fin m → M) → m ≤ n) :
  P N :=
begin
  haveI : decidable_eq M := classical.dec_eq M,
  have Pbot : P ⊥,
  { apply ih,
    intros N N_le x x_mem x_ortho,
    exfalso,
    simpa using x_ortho 1 0 N.zero_mem },

  induction n with n rank_ih generalizing N,
  { suffices : N = ⊥,
    { rwa this },
    apply eq_bot_of_rank_eq_zero b _ (λ m v hv, le_zero_iff.mp (rank_le v hv)) },
  apply ih,
  intros N' N'_le x x_mem x_ortho,
  apply rank_ih,
  intros m v hli,
  refine nat.succ_le_succ_iff.mp (rank_le (fin.cons ⟨x, x_mem⟩ (λ i, ⟨v i, N'_le (v i).2⟩)) _),
  convert hli.fin_cons' x _ _,
  { ext i, refine fin.cases _ _ i; simp },
  { intros c y hcy,
    refine x_ortho c y (submodule.span_le.mpr _ y.2) hcy,
    rintros _ ⟨z, rfl⟩,
    exact (v z).2 }
end

end induction

section division_ring

variables [division_ring K] [add_comm_group V] [add_comm_group V'] [module K V] [module K V']
variables {v : ι → V} {s t : set V} {x y z : V}

include K

open submodule

namespace basis

section exists_basis

/-- If `s` is a linear independent set of vectors, we can extend it to a basis. -/
noncomputable def extend (hs : linear_independent K (coe : s → V)) :
  basis _ K V :=
basis.mk
  (@linear_independent.restrict_of_comp_subtype _ _ _ id _ _ _ _ (hs.linear_independent_extend _))
  (set_like.coe_subset_coe.mp $ by simpa using hs.subset_span_extend (subset_univ s))

lemma extend_apply_self (hs : linear_independent K (coe : s → V))
  (x : hs.extend _) :
  basis.extend hs x = x :=
basis.mk_apply _ _ _

@[simp] lemma coe_extend (hs : linear_independent K (coe : s → V)) :
  ⇑(basis.extend hs) = coe :=
funext (extend_apply_self hs)

lemma range_extend (hs : linear_independent K (coe : s → V)) :
  range (basis.extend hs) = hs.extend (subset_univ _) :=
by rw [coe_extend, subtype.range_coe_subtype, set_of_mem_eq]

/-- If `v` is a linear independent family of vectors, extend it to a basis indexed by a sum type. -/
noncomputable def sum_extend (hs : linear_independent K v) :
  basis (ι ⊕ _) K V :=
let s := set.range v,
    e : ι ≃ s := equiv.of_injective v hs.injective,
    b := hs.to_subtype_range.extend (subset_univ (set.range v)) in
(basis.extend hs.to_subtype_range).reindex $ equiv.symm $
  calc ι ⊕ (b \ s : set V) ≃ s ⊕ (b \ s : set V) : equiv.sum_congr e (equiv.refl _)
  ... ≃ b                   :
    by haveI := classical.dec_pred (∈ s); exact
      equiv.set.sum_diff_subset (hs.to_subtype_range.subset_extend _)

lemma subset_extend {s : set V} (hs : linear_independent K (coe : s → V)) :
  s ⊆ hs.extend (set.subset_univ _) :=
hs.subset_extend _

section

variables (K V)

/-- A set used to index `basis.of_vector_space`. -/
noncomputable def of_vector_space_index : set V :=
(linear_independent_empty K V).extend (subset_univ _)

/-- Each vector space has a basis. -/
noncomputable def of_vector_space : basis (of_vector_space_index K V) K V :=
basis.extend (linear_independent_empty K V)

lemma of_vector_space_apply_self (x : of_vector_space_index K V) :
  of_vector_space K V x = x :=
basis.mk_apply _ _ _

@[simp] lemma coe_of_vector_space :
  ⇑(of_vector_space K V) = coe :=
funext (λ x, of_vector_space_apply_self K V x)

lemma of_vector_space_index.linear_independent :
  linear_independent K (coe : of_vector_space_index K V → V) :=
by { convert (of_vector_space K V).linear_independent, ext x, rw of_vector_space_apply_self }

lemma range_of_vector_space :
  range (of_vector_space K V) = of_vector_space_index K V :=
range_extend _

lemma exists_basis : ∃ s : set V, nonempty (basis s K V) :=
⟨of_vector_space_index K V, ⟨of_vector_space K V⟩⟩

end

end exists_basis

end basis

open fintype
variables (K V)

theorem vector_space.card_fintype [fintype K] [fintype V] :
  ∃ n : ℕ, card V = (card K) ^ n :=
by classical; exact
  ⟨card (basis.of_vector_space_index K V), module.card_fintype (basis.of_vector_space K V)⟩

section atoms_of_submodule_lattice

variables {K V}

/-- For a module over a division ring, the span of a nonzero element is an atom of the
lattice of submodules. -/
lemma nonzero_span_atom (v : V) (hv : v ≠ 0) : is_atom (span K {v} : submodule K V) :=
begin
  split,
  { rw submodule.ne_bot_iff, exact ⟨v, ⟨mem_span_singleton_self v, hv⟩⟩ },
  { intros T hT, by_contra, apply hT.2,
    change (span K {v}) ≤ T,
    simp_rw [span_singleton_le_iff_mem, ← ne.def, submodule.ne_bot_iff] at *,
    rcases h with ⟨s, ⟨hs, hz⟩⟩,
    cases (mem_span_singleton.1 (hT.1 hs)) with a ha,
    have h : a ≠ 0, by { intro h, rw [h, zero_smul] at ha, exact hz ha.symm },
    apply_fun (λ x, a⁻¹ • x) at ha,
    simp_rw [← mul_smul, inv_mul_cancel h, one_smul, ha] at *, exact smul_mem T _ hs},
end

/-- The atoms of the lattice of submodules of a module over a division ring are the
submodules equal to the span of a nonzero element of the module. -/
lemma atom_iff_nonzero_span (W : submodule K V) :
  is_atom W ↔ ∃ (v : V) (hv : v ≠ 0), W = span K {v} :=
begin
  refine ⟨λ h, _, λ h, _ ⟩,
  { cases h with hbot h,
    rcases ((submodule.ne_bot_iff W).1 hbot) with ⟨v, ⟨hW, hv⟩⟩,
    refine ⟨v, ⟨hv, _⟩⟩,
    by_contra heq,
    specialize h (span K {v}),
    rw [span_singleton_eq_bot, lt_iff_le_and_ne] at h,
    exact hv (h ⟨(span_singleton_le_iff_mem v W).2 hW, ne.symm heq⟩) },
  { rcases h with ⟨v, ⟨hv, rfl⟩⟩, exact nonzero_span_atom v hv },
end

/-- The lattice of submodules of a module over a division ring is atomistic. -/
instance : is_atomistic (submodule K V) :=
{ eq_Sup_atoms :=
  begin
    intro W,
    use {T : submodule K V | ∃ (v : V) (hv : v ∈ W) (hz : v ≠ 0), T = span K {v}},
    refine ⟨submodule_eq_Sup_le_nonzero_spans W, _⟩,
    rintros _ ⟨w, ⟨_, ⟨hw, rfl⟩⟩⟩, exact nonzero_span_atom w hw
  end }

end atoms_of_submodule_lattice

variables {K V}

lemma linear_map.exists_left_inverse_of_injective (f : V →ₗ[K] V')
  (hf_inj : f.ker = ⊥) : ∃g:V' →ₗ[K] V, g.comp f = linear_map.id :=
begin
  let B := basis.of_vector_space_index K V,
  let hB := basis.of_vector_space K V,
  have hB₀ : _ := hB.linear_independent.to_subtype_range,
  have : linear_independent K (λ x, x : f '' B → V'),
  { have h₁ : linear_independent K (λ (x : ↥(⇑f '' range (basis.of_vector_space _ _))), ↑x) :=
         @linear_independent.image_subtype _ _ _ _ _ _ _ _ _ f hB₀
      (show disjoint _ _, by simp [hf_inj]),
    rwa [basis.range_of_vector_space K V] at h₁ },
  let C := this.extend (subset_univ _),
  have BC := this.subset_extend (subset_univ _),
  let hC := basis.extend this,
  haveI : inhabited V := ⟨0⟩,
  refine ⟨hC.constr ℕ (C.restrict (inv_fun f)), hB.ext (λ b, _)⟩,
  rw image_subset_iff at BC,
  have fb_eq : f b = hC ⟨f b, BC b.2⟩,
  { change f b = basis.extend this _,
    rw [basis.extend_apply_self, subtype.coe_mk] },
  dsimp [hB],
  rw [basis.of_vector_space_apply_self, fb_eq, hC.constr_basis],
  exact left_inverse_inv_fun (linear_map.ker_eq_bot.1 hf_inj) _
end

lemma submodule.exists_is_compl (p : submodule K V) : ∃ q : submodule K V, is_compl p q :=
let ⟨f, hf⟩ := p.subtype.exists_left_inverse_of_injective p.ker_subtype in
⟨f.ker, linear_map.is_compl_of_proj $ linear_map.ext_iff.1 hf⟩

instance module.submodule.complemented_lattice : complemented_lattice (submodule K V) :=
⟨submodule.exists_is_compl⟩

lemma linear_map.exists_right_inverse_of_surjective (f : V →ₗ[K] V')
  (hf_surj : f.range = ⊤) : ∃g:V' →ₗ[K] V, f.comp g = linear_map.id :=
begin
  let C := basis.of_vector_space_index K V',
  let hC := basis.of_vector_space K V',
  haveI : inhabited V := ⟨0⟩,
  use hC.constr ℕ (C.restrict (inv_fun f)),
  refine hC.ext (λ c, _),
  rw [linear_map.comp_apply, hC.constr_basis],
  simp [right_inverse_inv_fun (linear_map.range_eq_top.1 hf_surj) c]
end

/-- Any linear map `f : p →ₗ[K] V'` defined on a subspace `p` can be extended to the whole
space. -/
lemma linear_map.exists_extend {p : submodule K V} (f : p →ₗ[K] V') :
  ∃ g : V →ₗ[K] V', g.comp p.subtype = f :=
let ⟨g, hg⟩ := p.subtype.exists_left_inverse_of_injective p.ker_subtype in
⟨f.comp g, by rw [linear_map.comp_assoc, hg, f.comp_id]⟩

open submodule linear_map

/-- If `p < ⊤` is a subspace of a vector space `V`, then there exists a nonzero linear map
`f : V →ₗ[K] K` such that `p ≤ ker f`. -/
lemma submodule.exists_le_ker_of_lt_top (p : submodule K V) (hp : p < ⊤) :
  ∃ f ≠ (0 : V →ₗ[K] K), p ≤ ker f :=
begin
  rcases set_like.exists_of_lt hp with ⟨v, -, hpv⟩, clear hp,
  rcases (linear_pmap.sup_span_singleton ⟨p, 0⟩ v (1 : K) hpv).to_fun.exists_extend with ⟨f, hf⟩,
  refine ⟨f, _, _⟩,
  { rintro rfl, rw [linear_map.zero_comp] at hf,
    have := linear_pmap.sup_span_singleton_apply_mk ⟨p, 0⟩ v (1 : K) hpv 0 p.zero_mem 1,
    simpa using (linear_map.congr_fun hf _).trans this },
  { refine λ x hx, mem_ker.2 _,
    have := linear_pmap.sup_span_singleton_apply_mk ⟨p, 0⟩ v (1 : K) hpv x hx 0,
    simpa using (linear_map.congr_fun hf _).trans this }
end

theorem quotient_prod_linear_equiv (p : submodule K V) :
  nonempty (((V ⧸ p) × p) ≃ₗ[K] V) :=
let ⟨q, hq⟩ := p.exists_is_compl in nonempty.intro $
((quotient_equiv_of_is_compl p q hq).prod (linear_equiv.refl _ _)).trans
  (prod_equiv_of_is_compl q p hq.symm)

end division_ring


import tactic.slim_check

-- example
--   (a : ℕ)
--   : ∀ {l₁ l₂ : list ℕ}, a ∈ l₁.diff l₂ → a ∈ l₁ ∧ a ∉ l₂ :=
-- by slim_check

/-
 Al descomentarlo da

 ===================
 Found problems!

 a := 0
 l₁ := [4, 4, 11, 178, 7, 5, 0, 0]
 l₂ := [511, 0, 2, 8, 3]
 (0 shrinks)
 -------------------
-/

-- lemma dvd_mul_a_b_then_a_or_b {a b x : ℕ} (h: (x ∣ (a*b))) : x ∣ a ∨ x ∣ b :=
-- by slim_check

/-
 Al descomentarlo da

 ===================
 Found problems!

 a := 10
 b := 6
 x := 4
 (0 shrinks)
 -------------------

 state:
 a b x : ℕ,
 h : x ∣ a * b
 ⊢ x ∣ a ∨ x ∣ b
-/