/-
Copyright (c) 2019 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Patrick Massot, Casper Putz
-/
import linear_algebra.finite_dimensional
import linear_algebra.nonsingular_inverse
import linear_algebra.multilinear
import linear_algebra.dual
import ring_theory.algebra_tower
import ring_theory.matrix_algebra

/-!
# Linear maps and matrices

This file defines the maps to send matrices to a linear map,
and to send linear maps between modules with a finite bases
to matrices. This defines a linear equivalence between linear maps
between finite-dimensional vector spaces and matrices indexed by
the respective bases.

It also defines the trace of an endomorphism, and the determinant of a family of vectors with
respect to some basis.

Some results are proved about the linear map corresponding to a
diagonal matrix (`range`, `ker` and `rank`).

Some results are proved for determinants of block triangular matrices.

## Main definitions

In the list below, and in all this file, `R` is a commutative ring (semiring
is sometimes enough), `M` and its variations are `R`-modules, `ι`, `κ`, `n` and `m` are finite
types used for indexing.

 * `linear_map.to_matrix`: given bases `v₁ : ι → M₁` and `v₂ : κ → M₂`,
   the `R`-linear equivalence from `M₁ →ₗ[R] M₂` to `matrix κ ι R`
 * `matrix.to_lin`: the inverse of `linear_map.to_matrix`
 * `linear_map.to_matrix'`: the `R`-linear equivalence from `(n → R) →ₗ[R] (m → R)`
   to `matrix n m R` (with the standard basis on `n → R` and `m → R`)
 * `matrix.to_lin'`: the inverse of `linear_map.to_matrix'`

 * `alg_equiv_matrix`: given a basis indexed by `n`, the `R`-algebra equivalence between
   `R`-endomorphisms of `M` and `matrix n n R`
 * `matrix.trace`: the trace of a square matrix
 * `linear_map.trace`: the trace of an endomorphism
 * `is_basis.to_matrix`: the matrix whose columns are a given family of vectors in a given basis
 * `is_basis.to_matrix_equiv`: given a basis, the linear equivalence between families of vectors
   and matrices arising from `is_basis.to_matrix`
 * `is_basis.det`: the determinant of a family of vectors with respect to a basis, as a multilinear
   map

## Tags

linear_map, matrix, linear_equiv, diagonal, det, trace

-/

noncomputable theory

open linear_map matrix set submodule
open_locale big_operators
open_locale matrix

universes u v w

section to_matrix'

variables {R : Type*} [comm_ring R]
variables {l m n : Type*} [fintype l] [fintype m] [fintype n]

instance [decidable_eq m] [decidable_eq n] (R) [fintype R] : fintype (matrix m n R) :=
by unfold matrix; apply_instance

/-- `matrix.mul_vec M` is a linear map. -/
def matrix.mul_vec_lin (M : matrix m n R) : (n → R) →ₗ[R] (m → R) :=
{ to_fun := M.mul_vec,
  map_add' := λ v w, funext (λ i, dot_product_add _ _ _),
  map_smul' := λ c v, funext (λ i, dot_product_smul _ _ _) }

@[simp] lemma matrix.mul_vec_lin_apply (M : matrix m n R) (v : n → R) :
  matrix.mul_vec_lin M v = M.mul_vec v := rfl

variables [decidable_eq n]

@[simp] lemma matrix.mul_vec_std_basis (M : matrix m n R) (i j) :
  M.mul_vec (std_basis R (λ _, R) j 1) i = M i j :=
begin
  have : (∑ j', M i j' * if j = j' then 1 else 0) = M i j,
  { simp_rw [mul_boole, finset.sum_ite_eq, finset.mem_univ, if_true] },
  convert this,
  ext,
  split_ifs with h; simp only [std_basis_apply],
  { rw [h, function.update_same] },
  { rw [function.update_noteq (ne.symm h), pi.zero_apply] }
end

/-- Linear maps `(n → R) →ₗ[R] (m → R)` are linearly equivalent to `matrix m n R`. -/
def linear_map.to_matrix' : ((n → R) →ₗ[R] (m → R)) ≃ₗ[R] matrix m n R :=
{ to_fun := λ f i j, f (std_basis R (λ _, R) j 1) i,
  inv_fun := matrix.mul_vec_lin,
  right_inv := λ M, by { ext i j, simp only [matrix.mul_vec_std_basis, matrix.mul_vec_lin_apply] },
  left_inv := λ f, begin
    apply (pi.is_basis_fun R n).ext,
    intro j, ext i,
    simp only [matrix.mul_vec_std_basis, matrix.mul_vec_lin_apply]
  end,
  map_add' := λ f g, by { ext i j, simp only [pi.add_apply, linear_map.add_apply] },
  map_smul' := λ c f, by { ext i j, simp only [pi.smul_apply, linear_map.smul_apply] } }

/-- A `matrix m n R` is linearly equivalent to a linear map `(n → R) →ₗ[R] (m → R)`. -/
def matrix.to_lin' : matrix m n R ≃ₗ[R] ((n → R) →ₗ[R] (m → R)) :=
linear_map.to_matrix'.symm

@[simp] lemma linear_map.to_matrix'_symm :
  (linear_map.to_matrix'.symm : matrix m n R ≃ₗ[R] _) = matrix.to_lin' :=
rfl

@[simp] lemma matrix.to_lin'_symm :
  (matrix.to_lin'.symm : ((n → R) →ₗ[R] (m → R)) ≃ₗ[R] _) = linear_map.to_matrix' :=
rfl

@[simp] lemma linear_map.to_matrix'_to_lin' (M : matrix m n R) :
  linear_map.to_matrix' (matrix.to_lin' M) = M :=
linear_map.to_matrix'.apply_symm_apply M

@[simp] lemma matrix.to_lin'_to_matrix' (f : (n → R) →ₗ[R] (m → R)) :
  matrix.to_lin' (linear_map.to_matrix' f) = f :=
matrix.to_lin'.apply_symm_apply f

@[simp] lemma linear_map.to_matrix'_apply (f : (n → R) →ₗ[R] (m → R)) (i j) :
  linear_map.to_matrix' f i j = f (λ j', if j' = j then 1 else 0) i :=
begin
  simp only [linear_map.to_matrix', linear_equiv.coe_mk],
  congr,
  ext j',
  split_ifs with h,
  { rw [h, std_basis_same] },
  apply std_basis_ne _ _ _ _ h
end

@[simp] lemma matrix.to_lin'_apply (M : matrix m n R) (v : n → R) :
  matrix.to_lin' M v = M.mul_vec v := rfl

@[simp] lemma matrix.to_lin'_one :
  matrix.to_lin' (1 : matrix n n R) = id :=
by { ext, simp [linear_map.one_apply, std_basis_apply] }

@[simp] lemma linear_map.to_matrix'_id :
  (linear_map.to_matrix' (linear_map.id : (n → R) →ₗ[R] (n → R))) = 1 :=
by { ext, rw [matrix.one_apply, linear_map.to_matrix'_apply, id_apply] }

@[simp] lemma matrix.to_lin'_mul [decidable_eq m] (M : matrix l m R) (N : matrix m n R) :
  matrix.to_lin' (M ⬝ N) = (matrix.to_lin' M).comp (matrix.to_lin' N) :=
by { ext, simp }

lemma linear_map.to_matrix'_comp [decidable_eq l]
  (f : (n → R) →ₗ[R] (m → R)) (g : (l → R) →ₗ[R] (n → R)) :
  (f.comp g).to_matrix' = f.to_matrix' ⬝ g.to_matrix' :=
suffices (f.comp g) = (f.to_matrix' ⬝ g.to_matrix').to_lin',
  by rw [this, linear_map.to_matrix'_to_lin'],
by rw [matrix.to_lin'_mul, matrix.to_lin'_to_matrix', matrix.to_lin'_to_matrix']

lemma linear_map.to_matrix'_mul [decidable_eq m]
  (f g : (m → R) →ₗ[R] (m → R)) :
  (f * g).to_matrix' = f.to_matrix' ⬝ g.to_matrix' :=
linear_map.to_matrix'_comp f g

/-- Linear maps `(n → R) →ₗ[R] (n → R)` are algebra equivalent to `matrix n n R`. -/
def linear_map.to_matrix_alg_equiv' : ((n → R) →ₗ[R] (n → R)) ≃ₐ[R] matrix n n R :=
alg_equiv.of_linear_equiv linear_map.to_matrix' linear_map.to_matrix'_mul
  (by simp [module.algebra_map_End_eq_smul_id])

/-- A `matrix n n R` is algebra equivalent to a linear map `(n → R) →ₗ[R] (n → R)`. -/
def matrix.to_lin_alg_equiv' : matrix n n R ≃ₐ[R] ((n → R) →ₗ[R] (n → R)) :=
linear_map.to_matrix_alg_equiv'.symm

@[simp] lemma linear_map.to_matrix_alg_equiv'_symm :
  (linear_map.to_matrix_alg_equiv'.symm : matrix n n R ≃ₐ[R] _) = matrix.to_lin_alg_equiv' :=
rfl

@[simp] lemma matrix.to_lin_alg_equiv'_symm :
  (matrix.to_lin_alg_equiv'.symm : ((n → R) →ₗ[R] (n → R)) ≃ₐ[R] _) =
    linear_map.to_matrix_alg_equiv' :=
rfl

@[simp] lemma linear_map.to_matrix_alg_equiv'_to_lin_alg_equiv' (M : matrix n n R) :
  linear_map.to_matrix_alg_equiv' (matrix.to_lin_alg_equiv' M) = M :=
linear_map.to_matrix_alg_equiv'.apply_symm_apply M

@[simp] lemma matrix.to_lin_alg_equiv'_to_matrix_alg_equiv' (f : (n → R) →ₗ[R] (n → R)) :
  matrix.to_lin_alg_equiv' (linear_map.to_matrix_alg_equiv' f) = f :=
matrix.to_lin_alg_equiv'.apply_symm_apply f

@[simp] lemma linear_map.to_matrix_alg_equiv'_apply (f : (n → R) →ₗ[R] (n → R)) (i j) :
  linear_map.to_matrix_alg_equiv' f i j = f (λ j', if j' = j then 1 else 0) i :=
by simp [linear_map.to_matrix_alg_equiv']

@[simp] lemma matrix.to_lin_alg_equiv'_apply (M : matrix n n R) (v : n → R) :
  matrix.to_lin_alg_equiv' M v = M.mul_vec v := rfl

@[simp] lemma matrix.to_lin_alg_equiv'_one :
  matrix.to_lin_alg_equiv' (1 : matrix n n R) = id :=
by { ext, simp [matrix.one_apply, std_basis_apply] }

@[simp] lemma linear_map.to_matrix_alg_equiv'_id :
  (linear_map.to_matrix_alg_equiv' (linear_map.id : (n → R) →ₗ[R] (n → R))) = 1 :=
by { ext, rw [matrix.one_apply, linear_map.to_matrix_alg_equiv'_apply, id_apply] }

@[simp] lemma matrix.to_lin_alg_equiv'_mul (M N : matrix n n R) :
  matrix.to_lin_alg_equiv' (M ⬝ N) =
    (matrix.to_lin_alg_equiv' M).comp (matrix.to_lin_alg_equiv' N) :=
by { ext, simp }

lemma linear_map.to_matrix_alg_equiv'_comp (f g : (n → R) →ₗ[R] (n → R)) :
  (f.comp g).to_matrix_alg_equiv' = f.to_matrix_alg_equiv' ⬝ g.to_matrix_alg_equiv' :=
suffices (f.comp g) = (f.to_matrix_alg_equiv' ⬝ g.to_matrix_alg_equiv').to_lin_alg_equiv',
  by rw [this, linear_map.to_matrix_alg_equiv'_to_lin_alg_equiv'],
by rw [matrix.to_lin_alg_equiv'_mul, matrix.to_lin_alg_equiv'_to_matrix_alg_equiv',
       matrix.to_lin_alg_equiv'_to_matrix_alg_equiv']

lemma linear_map.to_matrix_alg_equiv'_mul
  (f g : (n → R) →ₗ[R] (n → R)) :
  (f * g).to_matrix_alg_equiv' = f.to_matrix_alg_equiv' ⬝ g.to_matrix_alg_equiv' :=
linear_map.to_matrix_alg_equiv'_comp f g

end to_matrix'

section to_matrix

variables {R : Type*} [comm_ring R]
variables {l m n : Type*} [fintype l] [fintype m] [fintype n] [decidable_eq n]
variables {M₁ M₂ : Type*} [add_comm_group M₁] [add_comm_group M₂] [module R M₁] [module R M₂]
variables {v₁ : n → M₁} (hv₁ : is_basis R v₁) {v₂ : m → M₂} (hv₂ : is_basis R v₂)

/-- Given bases of two modules `M₁` and `M₂` over a commutative ring `R`, we get a linear
equivalence between linear maps `M₁ →ₗ M₂` and matrices over `R` indexed by the bases. -/
def linear_map.to_matrix : (M₁ →ₗ[R] M₂) ≃ₗ[R] matrix m n R :=
linear_equiv.trans (linear_equiv.arrow_congr hv₁.equiv_fun hv₂.equiv_fun) linear_map.to_matrix'

/-- Given bases of two modules `M₁` and `M₂` over a commutative ring `R`, we get a linear
equivalence between matrices over `R` indexed by the bases and linear maps `M₁ →ₗ M₂`. -/
def matrix.to_lin : matrix m n R ≃ₗ[R] (M₁ →ₗ[R] M₂) :=
(linear_map.to_matrix hv₁ hv₂).symm

@[simp] lemma linear_map.to_matrix_symm :
  (linear_map.to_matrix hv₁ hv₂).symm = matrix.to_lin hv₁ hv₂ :=
rfl

@[simp] lemma matrix.to_lin_symm :
  (matrix.to_lin hv₁ hv₂).symm = linear_map.to_matrix hv₁ hv₂ :=
rfl

@[simp] lemma matrix.to_lin_to_matrix (f : M₁ →ₗ[R] M₂) :
  matrix.to_lin hv₁ hv₂ (linear_map.to_matrix hv₁ hv₂ f) = f :=
by rw [← matrix.to_lin_symm, linear_equiv.apply_symm_apply]

@[simp] lemma linear_map.to_matrix_to_lin (M : matrix m n R) :
  linear_map.to_matrix hv₁ hv₂ (matrix.to_lin hv₁ hv₂ M) = M :=
by rw [← matrix.to_lin_symm, linear_equiv.symm_apply_apply]

lemma linear_map.to_matrix_apply (f : M₁ →ₗ[R] M₂) (i : m) (j : n) :
  linear_map.to_matrix hv₁ hv₂ f i j = hv₂.equiv_fun (f (v₁ j)) i :=
begin
  rw [linear_map.to_matrix, linear_equiv.trans_apply, linear_map.to_matrix'_apply,
      linear_equiv.arrow_congr_apply, is_basis.equiv_fun_symm_apply, finset.sum_eq_single j,
      if_pos rfl, one_smul],
  { intros j' _ hj',
    rw [if_neg hj', zero_smul] },
  { intro hj,
    have := finset.mem_univ j,
    contradiction }
end

lemma linear_map.to_matrix_transpose_apply (f : M₁ →ₗ[R] M₂) (j : n) :
  (linear_map.to_matrix hv₁ hv₂ f)ᵀ j = hv₂.equiv_fun (f (v₁ j)) :=
funext $ λ i, f.to_matrix_apply _ _ i j

lemma linear_map.to_matrix_apply' (f : M₁ →ₗ[R] M₂) (i : m) (j : n) :
  linear_map.to_matrix hv₁ hv₂ f i j = hv₂.repr (f (v₁ j)) i :=
linear_map.to_matrix_apply hv₁ hv₂ f i j

lemma linear_map.to_matrix_transpose_apply' (f : M₁ →ₗ[R] M₂) (j : n) :
  (linear_map.to_matrix hv₁ hv₂ f)ᵀ j = hv₂.repr (f (v₁ j)) :=
linear_map.to_matrix_transpose_apply hv₁ hv₂ f j

lemma matrix.to_lin_apply (M : matrix m n R) (v : M₁) :
  matrix.to_lin hv₁ hv₂ M v = ∑ j, M.mul_vec (hv₁.equiv_fun v) j • v₂ j :=
show hv₂.equiv_fun.symm (matrix.to_lin' M (hv₁.equiv_fun v)) = _,
by rw [matrix.to_lin'_apply, hv₂.equiv_fun_symm_apply]

@[simp] lemma matrix.to_lin_self (M : matrix m n R) (i : n) :
  matrix.to_lin hv₁ hv₂ M (v₁ i) = ∑ j, M j i • v₂ j :=
by simp only [matrix.to_lin_apply, matrix.mul_vec, dot_product, hv₁.equiv_fun_self, mul_boole,
  finset.sum_ite_eq, finset.mem_univ, if_true]

/-- This will be a special case of `linear_map.to_matrix_id_eq_basis_to_matrix`. -/
lemma linear_map.to_matrix_id : linear_map.to_matrix hv₁ hv₁ id = 1 :=
begin
  ext i j,
  simp [linear_map.to_matrix_apply, is_basis.equiv_fun, matrix.one_apply, finsupp.single, eq_comm]
end

lemma linear_map.to_matrix_one : linear_map.to_matrix hv₁ hv₁ 1 = 1 :=
linear_map.to_matrix_id hv₁

@[simp]
lemma matrix.to_lin_one : matrix.to_lin hv₁ hv₁ 1 = id :=
by rw [← linear_map.to_matrix_id hv₁, matrix.to_lin_to_matrix]

theorem linear_map.to_matrix_range [decidable_eq M₁] [decidable_eq M₂]
  (f : M₁ →ₗ[R] M₂) (k : m) (i : n) :
  linear_map.to_matrix hv₁.range hv₂.range f ⟨v₂ k, mem_range_self k⟩ ⟨v₁ i, mem_range_self i⟩ =
    linear_map.to_matrix hv₁ hv₂ f k i :=
by simp_rw [linear_map.to_matrix_apply, subtype.coe_mk, is_basis.equiv_fun_apply, hv₂.range_repr]

variables {M₃ : Type*} [add_comm_group M₃] [module R M₃] {v₃ : l → M₃} (hv₃ : is_basis R v₃)

lemma linear_map.to_matrix_comp [decidable_eq m] (f : M₂ →ₗ[R] M₃) (g : M₁ →ₗ[R] M₂) :
  linear_map.to_matrix hv₁ hv₃ (f.comp g) =
  linear_map.to_matrix hv₂ hv₃ f ⬝ linear_map.to_matrix hv₁ hv₂ g :=
by simp_rw [linear_map.to_matrix, linear_equiv.trans_apply,
            linear_equiv.arrow_congr_comp _ hv₂.equiv_fun, linear_map.to_matrix'_comp]

lemma linear_map.to_matrix_mul (f g : M₁ →ₗ[R] M₁) :
  linear_map.to_matrix hv₁ hv₁ (f * g) =
    linear_map.to_matrix hv₁ hv₁ f ⬝ linear_map.to_matrix hv₁ hv₁ g :=
by { rw [show (@has_mul.mul (M₁ →ₗ[R] M₁) _) = linear_map.comp, from rfl,
         linear_map.to_matrix_comp hv₁ hv₁ hv₁ f g] }

lemma linear_map.to_matrix_mul_vec_repr (f : M₁ →ₗ[R] M₂) (x : M₁) :
  (linear_map.to_matrix hv₁ hv₂ f).mul_vec (hv₁.repr x) = hv₂.repr (f x) :=
by { ext i,
     rw [← matrix.to_lin'_apply, linear_map.to_matrix, linear_equiv.trans_apply,
         matrix.to_lin'_to_matrix', linear_equiv.arrow_congr_apply, hv₂.equiv_fun_apply],
     congr,
     exact hv₁.equiv_fun.symm_apply_apply x }

lemma matrix.to_lin_mul [decidable_eq m] (A : matrix l m R) (B : matrix m n R) :
  matrix.to_lin hv₁ hv₃ (A ⬝ B) =
  (matrix.to_lin hv₂ hv₃ A).comp (matrix.to_lin hv₁ hv₂ B) :=
begin
  apply (linear_map.to_matrix hv₁ hv₃).injective,
  haveI : decidable_eq l := λ _ _, classical.prop_decidable _,
  rw linear_map.to_matrix_comp hv₁ hv₂ hv₃,
  repeat { rw linear_map.to_matrix_to_lin },
end

/-- Given a basis of a module `M₁` over a commutative ring `R`, we get an algebra
equivalence between linear maps `M₁ →ₗ M₁` and square matrices over `R` indexed by the basis. -/
def linear_map.to_matrix_alg_equiv :
  (M₁ →ₗ[R] M₁) ≃ₐ[R] matrix n n R :=
alg_equiv.of_linear_equiv (linear_map.to_matrix hv₁ hv₁) (linear_map.to_matrix_mul hv₁)
  (by simp [module.algebra_map_End_eq_smul_id, linear_map.to_matrix_id])

/-- Given a basis of a module `M₁` over a commutative ring `R`, we get an algebra
equivalence between square matrices over `R` indexed by the basis and linear maps `M₁ →ₗ M₁`. -/
def matrix.to_lin_alg_equiv : matrix n n R ≃ₐ[R] (M₁ →ₗ[R] M₁) :=
(linear_map.to_matrix_alg_equiv hv₁).symm

@[simp] lemma linear_map.to_matrix_alg_equiv_symm :
  (linear_map.to_matrix_alg_equiv hv₁).symm = matrix.to_lin_alg_equiv hv₁ :=
rfl

@[simp] lemma matrix.to_lin_alg_equiv_symm :
  (matrix.to_lin_alg_equiv hv₁).symm = linear_map.to_matrix_alg_equiv hv₁ :=
rfl

@[simp] lemma matrix.to_lin_alg_equiv_to_matrix_alg_equiv (f : M₁ →ₗ[R] M₁) :
  matrix.to_lin_alg_equiv hv₁ (linear_map.to_matrix_alg_equiv hv₁ f) = f :=
by rw [← matrix.to_lin_alg_equiv_symm, alg_equiv.apply_symm_apply]

@[simp] lemma linear_map.to_matrix_alg_equiv_to_lin_alg_equiv (M : matrix n n R) :
  linear_map.to_matrix_alg_equiv hv₁ (matrix.to_lin_alg_equiv hv₁ M) = M :=
by rw [← matrix.to_lin_alg_equiv_symm, alg_equiv.symm_apply_apply]

lemma linear_map.to_matrix_alg_equiv_apply (f : M₁ →ₗ[R] M₁) (i j : n) :
  linear_map.to_matrix_alg_equiv hv₁ f i j = hv₁.equiv_fun (f (v₁ j)) i :=
by simp [linear_map.to_matrix_alg_equiv, linear_map.to_matrix_apply]

lemma linear_map.to_matrix_alg_equiv_transpose_apply (f : M₁ →ₗ[R] M₁) (j : n) :
  (linear_map.to_matrix_alg_equiv hv₁ f)ᵀ j = hv₁.equiv_fun (f (v₁ j)) :=
funext $ λ i, f.to_matrix_apply _ _ i j

lemma linear_map.to_matrix_alg_equiv_apply' (f : M₁ →ₗ[R] M₁) (i j : n) :
  linear_map.to_matrix_alg_equiv hv₁ f i j = hv₁.repr (f (v₁ j)) i :=
linear_map.to_matrix_alg_equiv_apply hv₁ f i j

lemma linear_map.to_matrix_alg_equiv_transpose_apply' (f : M₁ →ₗ[R] M₁) (j : n) :
  (linear_map.to_matrix_alg_equiv hv₁ f)ᵀ j = hv₁.repr (f (v₁ j)) :=
linear_map.to_matrix_alg_equiv_transpose_apply hv₁ f j

lemma matrix.to_lin_alg_equiv_apply (M : matrix n n R) (v : M₁) :
  matrix.to_lin_alg_equiv hv₁ M v = ∑ j, M.mul_vec (hv₁.equiv_fun v) j • v₁ j :=
show hv₁.equiv_fun.symm (matrix.to_lin_alg_equiv' M (hv₁.equiv_fun v)) = _,
by rw [matrix.to_lin_alg_equiv'_apply, hv₁.equiv_fun_symm_apply]

@[simp] lemma matrix.to_lin_alg_equiv_self (M : matrix n n R) (i : n) :
  matrix.to_lin_alg_equiv hv₁ M (v₁ i) = ∑ j, M j i • v₁ j :=
by simp only [matrix.to_lin_alg_equiv_apply, matrix.mul_vec, dot_product, hv₁.equiv_fun_self,
  mul_boole, finset.sum_ite_eq, finset.mem_univ, if_true]

lemma linear_map.to_matrix_alg_equiv_id : linear_map.to_matrix_alg_equiv hv₁ id = 1 :=
by simp_rw [linear_map.to_matrix_alg_equiv, alg_equiv.of_linear_equiv_apply,
            linear_map.to_matrix_id]

@[simp]
lemma matrix.to_lin_alg_equiv_one : matrix.to_lin_alg_equiv hv₁ 1 = id :=
by rw [← linear_map.to_matrix_alg_equiv_id hv₁, matrix.to_lin_alg_equiv_to_matrix_alg_equiv]

theorem linear_map.to_matrix_alg_equiv_range [decidable_eq M₁]
  (f : M₁ →ₗ[R] M₁) (k i : n) :
  linear_map.to_matrix_alg_equiv hv₁.range f ⟨v₁ k, mem_range_self k⟩ ⟨v₁ i, mem_range_self i⟩ =
    linear_map.to_matrix_alg_equiv hv₁ f k i :=
by simp_rw [linear_map.to_matrix_alg_equiv_apply, subtype.coe_mk, is_basis.equiv_fun_apply,
            hv₁.range_repr]

lemma linear_map.to_matrix_alg_equiv_comp (f g : M₁ →ₗ[R] M₁) :
  linear_map.to_matrix_alg_equiv hv₁ (f.comp g) =
  linear_map.to_matrix_alg_equiv hv₁ f ⬝ linear_map.to_matrix_alg_equiv hv₁ g :=
by simp [linear_map.to_matrix_alg_equiv, linear_map.to_matrix_comp hv₁ hv₁ hv₁ f g]

lemma linear_map.to_matrix_alg_equiv_mul (f g : M₁ →ₗ[R] M₁) :
  linear_map.to_matrix_alg_equiv hv₁ (f * g) =
    linear_map.to_matrix_alg_equiv hv₁ f ⬝ linear_map.to_matrix_alg_equiv hv₁ g :=
by { rw [show (@has_mul.mul (M₁ →ₗ[R] M₁) _) = linear_map.comp, from rfl,
         linear_map.to_matrix_alg_equiv_comp hv₁ f g] }

lemma matrix.to_lin_alg_equiv_mul (A B : matrix n n R) :
  matrix.to_lin_alg_equiv hv₁ (A ⬝ B) =
  (matrix.to_lin_alg_equiv hv₁ A).comp (matrix.to_lin_alg_equiv hv₁ B) :=
by convert matrix.to_lin_mul hv₁ hv₁ hv₁ A B

end to_matrix

section is_basis_to_matrix

variables {ι ι' κ κ' : Type*} [fintype ι] [fintype ι'] [fintype κ] [fintype κ']
variables {R M : Type*} [comm_ring R] [add_comm_group M] [module R M]

open function matrix

/-- From a basis `e : ι → M` and a family of vectors `v : ι' → M`, make the matrix whose columns
are the vectors `v i` written in the basis `e`. -/
def is_basis.to_matrix {e : ι → M} (he : is_basis R e) (v : ι' → M) : matrix ι ι' R :=
λ i j, he.equiv_fun (v j) i

variables {e : ι → M} (he : is_basis R e) (v : ι' → M) (i : ι) (j : ι')

namespace is_basis

lemma to_matrix_apply : he.to_matrix v i j = he.equiv_fun (v j) i :=
rfl

lemma to_matrix_transpose_apply : (he.to_matrix v)ᵀ j = he.repr (v j) :=
funext $ (λ _, rfl)

lemma to_matrix_eq_to_matrix_constr [decidable_eq ι] (v : ι → M) :
  he.to_matrix v = linear_map.to_matrix he he (he.constr v) :=
by { ext, simp [is_basis.to_matrix_apply, linear_map.to_matrix_apply] }

@[simp] lemma to_matrix_self [decidable_eq ι] : he.to_matrix e = 1 :=
begin
  rw is_basis.to_matrix,
  ext i j,
  simp [is_basis.equiv_fun, matrix.one_apply, finsupp.single, eq_comm]
end

lemma to_matrix_update [decidable_eq ι'] (x : M) :
  he.to_matrix (function.update v j x) = matrix.update_column (he.to_matrix v) j (he.repr x) :=
begin
  ext i' k,
  rw [is_basis.to_matrix, matrix.update_column_apply, he.to_matrix_apply],
  split_ifs,
  { rw [h, update_same j x v, he.equiv_fun_apply] },
  { rw update_noteq h },
end

@[simp] lemma sum_to_matrix_smul_self : ∑ (i : ι), he.to_matrix v i j • e i = v j :=
begin
  conv_rhs { rw ← he.total_repr (v j) },
  rw [finsupp.total_apply, finsupp.sum_fintype],
  { refl },
  simp
end

@[simp] lemma to_lin_to_matrix [decidable_eq ι'] (hv : is_basis R v) :
  matrix.to_lin hv he (he.to_matrix v) = id :=
hv.ext (λ i, by rw [to_lin_self, id_apply, he.sum_to_matrix_smul_self])

/-- From a basis `e : ι → M`, build a linear equivalence between families of vectors `v : ι → M`,
and matrices, making the matrix whose columns are the vectors `v i` written in the basis `e`. -/
def to_matrix_equiv {e : ι → M} (he : is_basis R e) : (ι → M) ≃ₗ[R] matrix ι ι R :=
{ to_fun := he.to_matrix,
  map_add' := λ v w, begin
    ext i j,
    change _ = _ + _,
    simp [he.to_matrix_apply]
  end,
  map_smul' := begin
    intros c v,
    ext i j,
    simp [he.to_matrix_apply]
  end,
  inv_fun := λ m j, ∑ i, (m i j) • e i,
  left_inv := begin
    intro v,
    ext j,
    simp [he.to_matrix_apply, he.equiv_fun_total (v j)]
  end,
  right_inv := begin
    intros x,
    ext k l,
    simp [he.to_matrix_apply, he.equiv_fun.map_sum, he.equiv_fun.map_smul,
          fintype.sum_apply k (λ i, x i l • he.equiv_fun (e i)),
          he.equiv_fun_self]
  end }

end is_basis

section mul_linear_map_to_matrix

variables {N : Type*} [add_comm_group N] [module R N]
variables {b : ι → M} {b' : ι' → M} {c : κ → N} {c' : κ' → N}
variables (hb : is_basis R b) (hb' : is_basis R b') (hc : is_basis R c) (hc' : is_basis R c')
variables (f : M →ₗ[R] N)

open linear_map

@[simp] lemma is_basis_to_matrix_mul_linear_map_to_matrix [decidable_eq ι'] :
  hc.to_matrix c' ⬝ linear_map.to_matrix hb' hc' f = linear_map.to_matrix hb' hc f :=
(matrix.to_lin hb' hc).injective
  (by haveI := classical.dec_eq κ';
      rw [to_lin_to_matrix, to_lin_mul hb' hc' hc, to_lin_to_matrix, hc.to_lin_to_matrix, id_comp])

@[simp] lemma linear_map_to_matrix_mul_is_basis_to_matrix [decidable_eq ι] [decidable_eq ι'] :
  linear_map.to_matrix hb' hc' f ⬝ hb'.to_matrix b = linear_map.to_matrix hb hc' f :=
(matrix.to_lin hb hc').injective
  (by rw [to_lin_to_matrix, to_lin_mul hb hb' hc', to_lin_to_matrix, hb'.to_lin_to_matrix, comp_id])

/-- A generalization of `linear_map.to_matrix_id`. -/
@[simp] lemma linear_map.to_matrix_id_eq_basis_to_matrix [decidable_eq ι] :
  linear_map.to_matrix hb hb' id = hb'.to_matrix b :=
by { haveI := classical.dec_eq ι',
      rw [← is_basis_to_matrix_mul_linear_map_to_matrix hb hb', to_matrix_id, matrix.mul_one] }

/-- A generalization of `is_basis.to_matrix_self`, in the opposite direction. -/
@[simp] lemma is_basis.to_matrix_mul_to_matrix
  {ι'' : Type*} [fintype ι''] {b'' : ι'' → M} (hb'' : is_basis R b'') :
  hb.to_matrix b' ⬝ hb'.to_matrix b'' = hb.to_matrix b'' :=
begin
  haveI := classical.dec_eq ι,
  haveI := classical.dec_eq ι',
  haveI := classical.dec_eq ι'',
  rw [← linear_map.to_matrix_id_eq_basis_to_matrix hb' hb,
      ← linear_map.to_matrix_id_eq_basis_to_matrix hb'' hb',
      ← to_matrix_comp, id_comp, linear_map.to_matrix_id_eq_basis_to_matrix],
end

end mul_linear_map_to_matrix

end is_basis_to_matrix

open_locale matrix

section det

open linear_map matrix

variables {R : Type*} [comm_ring R]
variables {M : Type*} [add_comm_group M] [module R M]
variables {M' : Type*} [add_comm_group M'] [module R M']
variables {ι : Type*} [decidable_eq ι] [fintype ι] {v : ι → M} {v' : ι → M'}

lemma linear_equiv.is_unit_det (f : M ≃ₗ[R] M') (hv : is_basis R v) (hv' : is_basis R v') :
  is_unit (linear_map.to_matrix hv hv' f).det :=
begin
  apply is_unit_det_of_left_inverse,
  simpa using (linear_map.to_matrix_comp hv hv' hv f.symm f).symm
end

/-- Builds a linear equivalence from a linear map whose determinant in some bases is a unit. -/
def linear_equiv.of_is_unit_det {f : M →ₗ[R] M'} {hv : is_basis R v} {hv' : is_basis R v'}
  (h : is_unit (linear_map.to_matrix hv hv' f).det) : M ≃ₗ[R] M' :=
{ to_fun := f,
  map_add' := f.map_add,
  map_smul' := f.map_smul,
  inv_fun := to_lin hv' hv (to_matrix hv hv' f)⁻¹,
  left_inv := λ x,
    calc to_lin hv' hv (to_matrix hv hv' f)⁻¹ (f x)
        = to_lin hv hv ((to_matrix hv hv' f)⁻¹ ⬝ to_matrix hv hv' f) x :
      by { rw [to_lin_mul hv hv' hv, to_lin_to_matrix, linear_map.comp_apply] }
    ... = x : by simp [h],
  right_inv := λ x,
    calc f (to_lin hv' hv (to_matrix hv hv' f)⁻¹ x)
        = to_lin hv' hv' (to_matrix hv hv' f ⬝ (to_matrix hv hv' f)⁻¹) x :
      by { rw [to_lin_mul hv' hv hv', linear_map.comp_apply, to_lin_to_matrix hv hv'] }
    ... = x : by simp [h],
  }

variables {e : ι → M} (he : is_basis R e)

/-- The determinant of a family of vectors with respect to some basis, as an alternating
multilinear map. -/
def is_basis.det : alternating_map R M R ι :=
{ to_fun := λ v, det (he.to_matrix v),
  map_add' := begin
    intros v i x y,
    simp only [he.to_matrix_update, linear_map.map_add],
    apply det_update_column_add
  end,
  map_smul' := begin
    intros u i c x,
    simp only [he.to_matrix_update, algebra.id.smul_eq_mul, map_smul_of_tower],
    apply det_update_column_smul
  end,
  map_eq_zero_of_eq' := begin
    intros v i j h hij,
    rw [←function.update_eq_self i v, h, ←det_transpose, he.to_matrix_update,
        ←update_row_transpose, ←he.to_matrix_transpose_apply],
    apply det_zero_of_row_eq hij,
    rw [update_row_ne hij.symm, update_row_self],
  end }

lemma is_basis.det_apply (v : ι → M) : he.det v = det (he.to_matrix v) := rfl

lemma is_basis.det_self : he.det e = 1 :=
by simp [he.det_apply]

lemma is_basis.iff_det {v : ι → M} : is_basis R v ↔ is_unit (he.det v) :=
begin
  split,
  { intro hv,
    suffices :
      is_unit (linear_map.to_matrix he he (linear_equiv_of_is_basis he hv $ equiv.refl ι)).det,
    { rw [is_basis.det_apply, is_basis.to_matrix_eq_to_matrix_constr],
      exact this },
    apply linear_equiv.is_unit_det },
  { intro h,
    rw [is_basis.det_apply, is_basis.to_matrix_eq_to_matrix_constr] at h,
    convert linear_equiv.is_basis he (linear_equiv.of_is_unit_det h),
    ext i,
    exact (constr_basis he).symm },
end

end det

section transpose

variables {K V₁ V₂ ι₁ ι₂ : Type*} [field K]
          [add_comm_group V₁] [module K V₁]
          [add_comm_group V₂] [module K V₂]
          [fintype ι₁] [fintype ι₂] [decidable_eq ι₁] [decidable_eq ι₂]
          {B₁ : ι₁ → V₁} (h₁ : is_basis K B₁)
          {B₂ : ι₂ → V₂} (h₂ : is_basis K B₂)

@[simp] lemma linear_map.to_matrix_transpose (u : V₁ →ₗ[K] V₂) :
  linear_map.to_matrix h₂.dual_basis_is_basis h₁.dual_basis_is_basis (module.dual.transpose u) =
  (linear_map.to_matrix h₁ h₂ u)ᵀ :=
begin
  ext i j,
  simp only [linear_map.to_matrix_apply, module.dual.transpose_apply, h₁.dual_basis_equiv_fun,
             h₂.dual_basis_apply, matrix.transpose_apply, linear_map.comp_apply]
end

lemma linear_map.to_matrix_symm_transpose (M : matrix ι₁ ι₂ K) :
  (linear_map.to_matrix h₁.dual_basis_is_basis h₂.dual_basis_is_basis).symm Mᵀ =
  module.dual.transpose (matrix.to_lin h₂ h₁ M) :=
begin
  apply (linear_map.to_matrix h₁.dual_basis_is_basis h₂.dual_basis_is_basis).injective,
  rw [linear_equiv.apply_symm_apply],
  ext i j,
  simp only [linear_map.to_matrix_apply, module.dual.transpose_apply, h₂.dual_basis_equiv_fun,
    h₁.dual_basis_apply, matrix.transpose_apply, linear_map.comp_apply, if_true,
    matrix.to_lin_apply, linear_equiv.map_smul, mul_boole, algebra.id.smul_eq_mul,
    linear_equiv.map_sum, is_basis.equiv_fun_self, fintype.sum_apply, finset.sum_ite_eq',
    finset.sum_ite_eq, is_basis.equiv_fun_symm_apply, pi.smul_apply, matrix.to_lin_apply,
    matrix.mul_vec, matrix.dot_product, is_basis.equiv_fun_self, finset.mem_univ]
end

end transpose
namespace matrix

section trace

variables {m : Type*} [fintype m] (n : Type*) [fintype n]
variables (R : Type v) (M : Type w) [semiring R] [add_comm_monoid M] [module R M]

/--
The diagonal of a square matrix.
-/
def diag : (matrix n n M) →ₗ[R] n → M :=
{ to_fun    := λ A i, A i i,
  map_add'  := by { intros, ext, refl, },
  map_smul' := by { intros, ext, refl, } }

variables {n} {R} {M}

@[simp] lemma diag_apply (A : matrix n n M) (i : n) : diag n R M A i = A i i := rfl

@[simp] lemma diag_one [decidable_eq n] :
  diag n R R 1 = λ i, 1 := by { dunfold diag, ext, simp [one_apply_eq] }

@[simp] lemma diag_transpose (A : matrix n n M) : diag n R M Aᵀ = diag n R M A := rfl

variables (n) (R) (M)

/--
The trace of a square matrix.
-/
def trace : (matrix n n M) →ₗ[R] M :=
{ to_fun    := λ A, ∑ i, diag n R M A i,
  map_add'  := by { intros, apply finset.sum_add_distrib, },
  map_smul' := by { intros, simp [finset.smul_sum], } }

variables {n} {R} {M}

@[simp] lemma trace_diag (A : matrix n n M) : trace n R M A = ∑ i, diag n R M A i := rfl

lemma trace_apply (A : matrix n n M) : trace n R M A = ∑ i, A i i := rfl

@[simp] lemma trace_one [decidable_eq n] :
  trace n R R 1 = fintype.card n :=
have h : trace n R R 1 = ∑ i, diag n R R 1 i := rfl,
by simp_rw [h, diag_one, finset.sum_const, nsmul_one]; refl

@[simp] lemma trace_transpose (A : matrix n n M) : trace n R M Aᵀ = trace n R M A := rfl

@[simp] lemma trace_transpose_mul (A : matrix m n R) (B : matrix n m R) :
  trace n R R (Aᵀ ⬝ Bᵀ) = trace m R R (A ⬝ B) := finset.sum_comm

lemma trace_mul_comm {S : Type v} [comm_ring S] (A : matrix m n S) (B : matrix n m S) :
  trace n S S (B ⬝ A) = trace m S S (A ⬝ B) :=
by rw [←trace_transpose, ←trace_transpose_mul, transpose_mul]

end trace

section ring

variables {n : Type*} [fintype n] [decidable_eq n] {R : Type v} [comm_ring R]
open linear_map matrix

lemma proj_diagonal (i : n) (w : n → R) :
  (proj i).comp (to_lin' (diagonal w)) = (w i) • proj i :=
by ext j; simp [mul_vec_diagonal]

lemma diagonal_comp_std_basis (w : n → R) (i : n) :
  (diagonal w).to_lin'.comp (std_basis R (λ_:n, R) i) = (w i) • std_basis R (λ_:n, R) i :=
begin
  ext j,
  simp_rw [linear_map.comp_apply, to_lin'_apply, mul_vec_diagonal, linear_map.smul_apply,
    pi.smul_apply, algebra.id.smul_eq_mul],
  by_cases i = j,
  { subst h },
  { rw [std_basis_ne R (λ_:n, R) _ _ (ne.symm h), _root_.mul_zero, _root_.mul_zero] }
end

lemma diagonal_to_lin' (w : n → R) :
  (diagonal w).to_lin' = linear_map.pi (λi, w i • linear_map.proj i) :=
by ext v j; simp [mul_vec_diagonal]

/-- An invertible matrix yields a linear equivalence from the free module to itself.

See `matrix.to_linear_equiv` for the same map on arbitrary modules.
-/
def to_linear_equiv' (P : matrix n n R) (h : is_unit P) : (n → R) ≃ₗ[R] (n → R) :=
have h' : is_unit P.det := P.is_unit_iff_is_unit_det.mp h,
{ inv_fun   := P⁻¹.to_lin',
  left_inv  := λ v,
    show (P⁻¹.to_lin'.comp P.to_lin') v = v,
    by rw [← matrix.to_lin'_mul, P.nonsing_inv_mul h', matrix.to_lin'_one, linear_map.id_apply],
  right_inv := λ v,
    show (P.to_lin'.comp P⁻¹.to_lin') v = v,
    by rw [← matrix.to_lin'_mul, P.mul_nonsing_inv h', matrix.to_lin'_one, linear_map.id_apply],
  ..P.to_lin' }

@[simp] lemma to_linear_equiv'_apply (P : matrix n n R) (h : is_unit P) :
  (↑(P.to_linear_equiv' h) : module.End R (n → R)) = P.to_lin' := rfl

@[simp] lemma to_linear_equiv'_symm_apply (P : matrix n n R) (h : is_unit P) :
  (↑(P.to_linear_equiv' h).symm : module.End R (n → R)) = P⁻¹.to_lin' := rfl

end ring

section module

variables {m n : Type*} [fintype m] [fintype n]
variables {K : Type u} [field K] -- maybe try to relax the universe constraint

open linear_map matrix

lemma rank_vec_mul_vec {m n : Type u} [fintype m] [fintype n] [decidable_eq n]
  (w : m → K) (v : n → K) :
  rank (vec_mul_vec w v).to_lin' ≤ 1 :=
begin
  rw [vec_mul_vec_eq, to_lin'_mul],
  refine le_trans (rank_comp_le1 _ _) _,
  refine le_trans (rank_le_domain _) _,
  rw [dim_fun', ← cardinal.lift_eq_nat_iff.mpr (cardinal.fintype_card unit), cardinal.mk_unit],
  exact le_of_eq (cardinal.lift_one)
end

lemma ker_diagonal_to_lin' [decidable_eq m] (w : m → K) :
  ker (diagonal w).to_lin' = (⨆i∈{i | w i = 0 }, range (std_basis K (λi, K) i)) :=
begin
  rw [← comap_bot, ← infi_ker_proj],
  simp only [comap_infi, (ker_comp _ _).symm, proj_diagonal, ker_smul'],
  have : univ ⊆ {i : m | w i = 0} ∪ {i : m | w i = 0}ᶜ, { rw set.union_compl_self },
  exact (supr_range_std_basis_eq_infi_ker_proj K (λi:m, K)
    disjoint_compl_right this (finite.of_fintype _)).symm
end

lemma range_diagonal [decidable_eq m] (w : m → K) :
  (diagonal w).to_lin'.range = (⨆ i ∈ {i | w i ≠ 0}, (std_basis K (λi, K) i).range) :=
begin
  dsimp only [mem_set_of_eq],
  rw [← map_top, ← supr_range_std_basis, map_supr],
  congr, funext i,
  rw [← linear_map.range_comp, diagonal_comp_std_basis, ← range_smul']
end

lemma rank_diagonal [decidable_eq m] [decidable_eq K] (w : m → K) :
  rank (diagonal w).to_lin' = fintype.card { i // w i ≠ 0 } :=
begin
  have hu : univ ⊆ {i : m | w i = 0}ᶜ ∪ {i : m | w i = 0}, { rw set.compl_union_self },
  have hd : disjoint {i : m | w i ≠ 0} {i : m | w i = 0} := disjoint_compl_left,
  have h₁ := supr_range_std_basis_eq_infi_ker_proj K (λi:m, K) hd hu (finite.of_fintype _),
  have h₂ := @infi_ker_proj_equiv K _ _ (λi:m, K) _ _ _ _ (by simp; apply_instance) hd hu,
  rw [rank, range_diagonal, h₁, ←@dim_fun' K],
  apply linear_equiv.dim_eq,
  apply h₂,
end

variables {R M : Type*} [comm_ring R] [add_comm_group M] [module R M]
variables {b : n → M} (hb : is_basis R b)

include hb

/-- Given `hA : is_unit A.det` and `hb : is_basis R b`, `A.to_linear_equiv hb hA` is
the `linear_equiv` arising from `to_lin hb hb A`.

See `matrix.to_linear_equiv'` for this result on `n → R`.
-/
@[simps apply]
def to_linear_equiv [decidable_eq n] (A : matrix n n R) (hA : is_unit A.det) :
  M ≃ₗ[R] M :=
begin
  refine ⟨to_lin hb hb A, linear_map.map_add _, linear_map.map_smul _, to_lin hb hb A⁻¹,
          λ x, _, λ x, _⟩;
  simp only [← linear_map.comp_apply, ← to_lin_mul,
             matrix.nonsing_inv_mul _ hA, matrix.mul_nonsing_inv _ hA,
             to_lin_one, linear_map.id_apply]
end
lemma ker_to_lin_eq_bot [decidable_eq n] (A : matrix n n R) (hA : is_unit A.det) :
  (to_lin hb hb A).ker = ⊥ :=
ker_eq_bot.mpr (to_linear_equiv hb A hA).injective

lemma range_to_lin_eq_top [decidable_eq n] (A : matrix n n R) (hA : is_unit A.det) :
  (to_lin hb hb A).range = ⊤ :=
range_eq_top.mpr (to_linear_equiv hb A hA).surjective

end module

section finite_dimensional

variables {m n : Type*} [fintype m] [fintype n]
variables {R : Type v} [field R]

instance : finite_dimensional R (matrix m n R) :=
linear_equiv.finite_dimensional (linear_equiv.uncurry R m n).symm

/--
The dimension of the space of finite dimensional matrices
is the product of the number of rows and columns.
-/
@[simp] lemma finrank_matrix :
  finite_dimensional.finrank R (matrix m n R) = fintype.card m * fintype.card n :=
by rw [@linear_equiv.finrank_eq R (matrix m n R) _ _ _ _ _ _ (linear_equiv.uncurry R m n),
       finite_dimensional.finrank_fintype_fun_eq_card, fintype.card_prod]

end finite_dimensional

section reindexing

variables {l m n : Type*} [fintype l] [fintype m] [fintype n]
variables {l' m' n' : Type*} [fintype l'] [fintype m'] [fintype n']
variables {R : Type v}

/-- The natural map that reindexes a matrix's rows and columns with equivalent types,
`matrix.reindex`, is a linear equivalence. -/
def reindex_linear_equiv [semiring R] (eₘ : m ≃ m') (eₙ : n ≃ n') :
  matrix m n R ≃ₗ[R] matrix m' n' R :=
{ map_add'  := λ M N, rfl,
  map_smul' := λ M N, rfl,
  ..(reindex eₘ eₙ)}

@[simp] lemma reindex_linear_equiv_apply [semiring R]
  (eₘ : m ≃ m') (eₙ : n ≃ n') (M : matrix m n R) :
  reindex_linear_equiv eₘ eₙ M = reindex eₘ eₙ M :=
rfl

@[simp] lemma reindex_linear_equiv_symm [semiring R] (eₘ : m ≃ m') (eₙ : n ≃ n') :
  (reindex_linear_equiv eₘ eₙ : _ ≃ₗ[R] _).symm = reindex_linear_equiv eₘ.symm eₙ.symm :=
rfl

@[simp] lemma reindex_linear_equiv_refl_refl [semiring R] :
  reindex_linear_equiv (equiv.refl m) (equiv.refl n) = linear_equiv.refl R _ :=
linear_equiv.ext $ λ _, rfl

/-- For square matrices, the natural map that reindexes a matrix's rows and columns with equivalent
types, `matrix.reindex`, is an equivalence of algebras. -/
def reindex_alg_equiv [comm_semiring R] [decidable_eq m] [decidable_eq n]
  (e : m ≃ n) : matrix m m R ≃ₐ[R] matrix n n R :=
{ to_fun    := reindex e e,
  map_mul'  := λ M N, minor_mul_equiv M N e.symm e.symm e.symm,
  commutes' := λ r, by simp [algebra_map, algebra.to_ring_hom, minor_smul],
  ..(reindex_linear_equiv e e) }

@[simp] lemma reindex_alg_equiv_apply [comm_semiring R] [decidable_eq m] [decidable_eq n]
  (e : m ≃ n) (M : matrix m m R) :
  reindex_alg_equiv e M = reindex e e M :=
rfl

@[simp] lemma reindex_alg_equiv_symm [comm_semiring R] [decidable_eq m] [decidable_eq n]
  (e : m ≃ n) :
  (reindex_alg_equiv e : _ ≃ₐ[R] _).symm = reindex_alg_equiv e.symm :=
rfl

@[simp] lemma reindex_alg_equiv_refl [comm_semiring R] [decidable_eq m] :
  reindex_alg_equiv (equiv.refl m) = (alg_equiv.refl : _ ≃ₐ[R] _) :=
alg_equiv.ext $ λ _, rfl

/-- Reindexing both indices along the same equivalence preserves the determinant.

For the `simp` version of this lemma, see `det_minor_equiv_self`.
-/
lemma det_reindex_linear_equiv_self [decidable_eq m] [decidable_eq n] [comm_ring R]
  (e : m ≃ n) (A : matrix m m R) :
  det (reindex_linear_equiv e e A) = det A :=
det_reindex_self e A

/-- Reindexing both indices along the same equivalence preserves the determinant.

For the `simp` version of this lemma, see `det_minor_equiv_self`.
-/
lemma det_reindex_alg_equiv [decidable_eq m] [decidable_eq n] [comm_ring R]
  (e : m ≃ n) (A : matrix m m R) :
  det (reindex_alg_equiv e A) = det A :=
det_reindex_self e A

end reindexing

end matrix

namespace algebra

section lmul

variables {R S T : Type*} [comm_ring R] [comm_ring S] [comm_ring T]
variables [algebra R S] [algebra S T] [algebra R T] [is_scalar_tower R S T]
variables {m n : Type*} [fintype m] [decidable_eq m] [fintype n] [decidable_eq n]
variables {b : m → S} (hb : is_basis R b) {c : n → T} (hc : is_basis S c)

open algebra

lemma to_matrix_lmul' (x : S) (i j) :
  linear_map.to_matrix hb hb (lmul R S x) i j = hb.repr (x * b j) i :=
by rw [linear_map.to_matrix_apply', lmul_apply]

@[simp] lemma to_matrix_lsmul (x : R) (i j) :
  linear_map.to_matrix hb hb (algebra.lsmul R S x) i j = if i = j then x else 0 :=
by { rw [linear_map.to_matrix_apply', algebra.lsmul_coe, linear_map.map_smul, finsupp.smul_apply,
         hb.repr_self_apply, smul_eq_mul, mul_boole],
     congr' 1; simp only [eq_comm] }

/-- `left_mul_matrix hb x` is the matrix corresponding to the linear map `λ y, x * y`.

`left_mul_matrix_eq_repr_mul` gives a formula for the entries of `left_mul_matrix`.

This definition is useful for doing (more) explicit computations with `algebra.lmul`,
such as the trace form or norm map for algebras.
-/
noncomputable def left_mul_matrix : S →ₐ[R] matrix m m R :=
{ to_fun := λ x, linear_map.to_matrix hb hb (algebra.lmul R S x),
  map_zero' := by rw [alg_hom.map_zero, linear_equiv.map_zero],
  map_one' := by rw [alg_hom.map_one, linear_map.to_matrix_one],
  map_add' := λ x y, by rw [alg_hom.map_add, linear_equiv.map_add],
  map_mul' := λ x y, by rw [alg_hom.map_mul, linear_map.to_matrix_mul, matrix.mul_eq_mul],
  commutes' := λ r, by { ext, rw [lmul_algebra_map, to_matrix_lsmul,
                                  algebra_map_matrix_apply, id.map_eq_self] } }

lemma left_mul_matrix_apply (x : S) :
  left_mul_matrix hb x = linear_map.to_matrix hb hb (lmul R S x) := rfl

lemma left_mul_matrix_eq_repr_mul (x : S) (i j) :
  left_mul_matrix hb x i j = hb.repr (x * b j) i :=
-- This is defeq to just `to_matrix_lmul' hb x i j`,
-- but the unfolding goes a lot faster with this explicit `rw`.
by rw [left_mul_matrix_apply, to_matrix_lmul' hb x i j]

lemma left_mul_matrix_mul_vec_repr (x y : S) :
  (left_mul_matrix hb x).mul_vec (hb.repr y) = hb.repr (x * y) :=
linear_map.to_matrix_mul_vec_repr hb hb (algebra.lmul R S x) y

@[simp] lemma to_matrix_lmul_eq (x : S) :
  linear_map.to_matrix hb hb (lmul R S x) = left_mul_matrix hb x :=
rfl

lemma left_mul_matrix_injective : function.injective (left_mul_matrix hb) :=
λ x x' h, calc x = algebra.lmul R S x 1 : (mul_one x).symm
             ... = algebra.lmul R S x' 1 : by rw (linear_map.to_matrix hb hb).injective h
             ... = x' : mul_one x'

lemma smul_left_mul_matrix (x) (i j) (k k') :
  left_mul_matrix (hb.smul hc) x (i, k) (j, k') =
    left_mul_matrix hb (left_mul_matrix hc x k k') i j :=
by simp only [left_mul_matrix_apply, linear_map.to_matrix_apply, is_basis.equiv_fun_apply, mul_comm,
              is_basis.smul_repr, finsupp.smul_apply, algebra.lmul_apply, id.smul_eq_mul,
              linear_map.map_smul, mul_smul_comm]

lemma smul_left_mul_matrix_algebra_map (x : S) :
  left_mul_matrix (hb.smul hc) (algebra_map _ _ x) = block_diagonal (λ k, left_mul_matrix hb x) :=
begin
  ext ⟨i, k⟩ ⟨j, k'⟩,
  rw [smul_left_mul_matrix, alg_hom.commutes, block_diagonal_apply, algebra_map_matrix_apply],
  split_ifs with h; simp [h],
end

lemma smul_left_mul_matrix_algebra_map_eq (x : S) (i j k) :
  left_mul_matrix (hb.smul hc) (algebra_map _ _ x) (i, k) (j, k) = left_mul_matrix hb x i j :=
by rw [smul_left_mul_matrix_algebra_map, block_diagonal_apply_eq]

lemma smul_left_mul_matrix_algebra_map_ne (x : S) (i j) {k k'}
  (h : k ≠ k') : left_mul_matrix (hb.smul hc) (algebra_map _ _ x) (i, k) (j, k') = 0 :=
by rw [smul_left_mul_matrix_algebra_map, block_diagonal_apply_ne _ _ _ h]

end lmul

end algebra

namespace linear_map

open_locale matrix

/-- The trace of an endomorphism given a basis. -/
def trace_aux (R : Type u) [comm_ring R] {M : Type v} [add_comm_group M] [module R M]
  {ι : Type w} [decidable_eq ι] [fintype ι] {b : ι → M} (hb : is_basis R b) :
  (M →ₗ[R] M) →ₗ[R] R :=
(matrix.trace ι R R).comp $ linear_map.to_matrix hb hb

-- Can't be `simp` because it would cause a loop.
lemma trace_aux_def (R : Type u) [comm_ring R] {M : Type v} [add_comm_group M] [module R M]
  {ι : Type w} [decidable_eq ι] [fintype ι] {b : ι → M} (hb : is_basis R b) (f : M →ₗ[R] M) :
  trace_aux R hb f = matrix.trace ι R R (linear_map.to_matrix hb hb f) :=
rfl

theorem trace_aux_eq' (R : Type u) [comm_ring R] {M : Type v} [add_comm_group M] [module R M]
  {ι : Type w} [decidable_eq ι] [fintype ι] {b : ι → M} (hb : is_basis R b)
  {κ : Type w} [decidable_eq κ] [fintype κ] {c : κ → M} (hc : is_basis R c) :
  trace_aux R hb = trace_aux R hc :=
linear_map.ext $ λ f,
calc  matrix.trace ι R R (linear_map.to_matrix hb hb f)
    = matrix.trace ι R R (linear_map.to_matrix hb hb ((linear_map.id.comp f).comp linear_map.id)) :
  by rw [linear_map.id_comp, linear_map.comp_id]
... = matrix.trace ι R R (linear_map.to_matrix hc hb linear_map.id ⬝
        linear_map.to_matrix hc hc f ⬝
        linear_map.to_matrix hb hc linear_map.id) :
  by rw [linear_map.to_matrix_comp _ hc, linear_map.to_matrix_comp _ hc]
... = matrix.trace κ R R (linear_map.to_matrix hc hc f ⬝
        linear_map.to_matrix hb hc linear_map.id ⬝
        linear_map.to_matrix hc hb linear_map.id) :
  by rw [matrix.mul_assoc, matrix.trace_mul_comm]
... = matrix.trace κ R R (linear_map.to_matrix hc hc ((f.comp linear_map.id).comp linear_map.id)) :
  by rw [linear_map.to_matrix_comp _ hb, linear_map.to_matrix_comp _ hc]
... = matrix.trace κ R R (linear_map.to_matrix hc hc f) :
  by rw [linear_map.comp_id, linear_map.comp_id]

open_locale classical

theorem trace_aux_range (R : Type u) [comm_ring R] {M : Type v} [add_comm_group M] [module R M]
  {ι : Type w} [decidable_eq ι] [fintype ι] {b : ι → M} (hb : is_basis R b) :
  trace_aux R hb.range = trace_aux R hb :=
linear_map.ext $ λ f, if H : 0 = 1 then eq_of_zero_eq_one H _ _ else
begin
  haveI : nontrivial R := ⟨⟨0, 1, H⟩⟩,
  change ∑ i : set.range b, _ = ∑ i : ι, _, simp_rw [matrix.diag_apply], symmetry,
  convert (equiv.of_injective _ hb.injective).sum_comp _, ext i,
  exact (linear_map.to_matrix_range hb hb f i i).symm
end

/-- where `ι` and `κ` can reside in different universes -/
theorem trace_aux_eq (R : Type u) [comm_ring R] {M : Type v} [add_comm_group M] [module R M]
  {ι : Type*} [decidable_eq ι] [fintype ι] {b : ι → M} (hb : is_basis R b)
  {κ : Type*} [decidable_eq κ] [fintype κ] {c : κ → M} (hc : is_basis R c) :
  trace_aux R hb = trace_aux R hc :=
calc  trace_aux R hb
    = trace_aux R hb.range : by rw trace_aux_range R hb
... = trace_aux R hc.range : trace_aux_eq' _ _ _
... = trace_aux R hc : by rw trace_aux_range R hc

/-- Trace of an endomorphism independent of basis. -/
def trace (R : Type u) [comm_ring R] (M : Type v) [add_comm_group M] [module R M] :
  (M →ₗ[R] M) →ₗ[R] R :=
if H : ∃ s : finset M, is_basis R (λ x, x : (↑s : set M) → M)
then trace_aux R (classical.some_spec H)
else 0

theorem trace_eq_matrix_trace (R : Type u) [comm_ring R] {M : Type v} [add_comm_group M]
  [module R M] {ι : Type w} [fintype ι] [decidable_eq ι] {b : ι → M} (hb : is_basis R b)
  (f : M →ₗ[R] M) :
  trace R M f = matrix.trace ι R R (linear_map.to_matrix hb hb f) :=
have ∃ s : finset M, is_basis R (λ x, x : (↑s : set M) → M),
from ⟨finset.univ.image b,
  by { rw [finset.coe_image, finset.coe_univ, set.image_univ], exact hb.range }⟩,
by { rw [trace, dif_pos this, ← trace_aux_def], congr' 1, apply trace_aux_eq }

theorem trace_mul_comm (R : Type u) [comm_ring R] {M : Type v} [add_comm_group M] [module R M]
  (f g : M →ₗ[R] M) : trace R M (f * g) = trace R M (g * f) :=
if H : ∃ s : finset M, is_basis R (λ x, x : (↑s : set M) → M) then let ⟨s, hb⟩ := H in
by { simp_rw [trace_eq_matrix_trace R hb, linear_map.to_matrix_mul], apply matrix.trace_mul_comm }
else by rw [trace, dif_neg H, linear_map.zero_apply, linear_map.zero_apply]

section finite_dimensional

variables {K : Type*} [field K]
variables {V : Type*} [add_comm_group V] [module K V] [finite_dimensional K V]
variables {W : Type*} [add_comm_group W] [module K W] [finite_dimensional K W]

instance : finite_dimensional K (V →ₗ[K] W) :=
begin
  classical,
  cases finite_dimensional.exists_is_basis_finset K V with bV hbV,
  cases finite_dimensional.exists_is_basis_finset K W with bW hbW,
  apply linear_equiv.finite_dimensional (linear_map.to_matrix hbV hbW).symm,
end

/--
The dimension of the space of linear transformations is the product of the dimensions of the
domain and codomain.
-/
@[simp] lemma finrank_linear_map :
  finite_dimensional.finrank K (V →ₗ[K] W) =
  (finite_dimensional.finrank K V) * (finite_dimensional.finrank K W) :=
begin
  classical,
  cases finite_dimensional.exists_is_basis_finset K V with bV hbV,
  cases finite_dimensional.exists_is_basis_finset K W with bW hbW,
  rw [linear_equiv.finrank_eq (linear_map.to_matrix hbV hbW), matrix.finrank_matrix,
    finite_dimensional.finrank_eq_card_basis hbV, finite_dimensional.finrank_eq_card_basis hbW,
    mul_comm],
end

end finite_dimensional
end linear_map

/-- The natural equivalence between linear endomorphisms of finite free modules and square matrices
is compatible with the algebra structures. -/
def alg_equiv_matrix' {R : Type v} [comm_ring R] {n : Type*} [fintype n] [decidable_eq n] :
  module.End R (n → R) ≃ₐ[R] matrix n n R :=
{ map_mul'  := linear_map.to_matrix'_comp,
  map_add'  := linear_map.to_matrix'.map_add,
  commutes' := λ r, by { change (r • (linear_map.id : module.End R _)).to_matrix' = r • 1,
                         rw ←linear_map.to_matrix'_id, refl, },
  ..linear_map.to_matrix' }

/-- A linear equivalence of two modules induces an equivalence of algebras of their
endomorphisms. -/
def linear_equiv.alg_conj {R : Type v} [comm_ring R] {M₁ M₂ : Type*}
  [add_comm_group M₁] [module R M₁] [add_comm_group M₂] [module R M₂] (e : M₁ ≃ₗ[R] M₂) :
  module.End R M₁ ≃ₐ[R] module.End R M₂ :=
{ map_mul'  := λ f g, by apply e.arrow_congr_comp,
  map_add'  := e.conj.map_add,
  commutes' := λ r, by { change e.conj (r • linear_map.id) = r • linear_map.id,
                         rw [linear_equiv.map_smul, linear_equiv.conj_id], },
  ..e.conj }

/-- A basis of a module induces an equivalence of algebras from the endomorphisms of the module to
square matrices. -/
def alg_equiv_matrix {R : Type v} {M : Type w} {n : Type*} [fintype n]
  [comm_ring R] [add_comm_group M] [module R M] [decidable_eq n] {b : n → M} (h : is_basis R b) :
  module.End R M ≃ₐ[R] matrix n n R :=
h.equiv_fun.alg_conj.trans alg_equiv_matrix'

section

variables {R : Type v} [semiring R] {n : Type w} [fintype n]

@[simp] lemma matrix.dot_product_std_basis_eq_mul [decidable_eq n] (v : n → R) (c : R) (i : n) :
  matrix.dot_product v (linear_map.std_basis R (λ _, R) i c) = v i * c :=
begin
  rw [matrix.dot_product, finset.sum_eq_single i, linear_map.std_basis_same],
  exact λ _ _ hb, by rw [linear_map.std_basis_ne _ _ _ _ hb, mul_zero],
  exact λ hi, false.elim (hi $ finset.mem_univ _)
end

@[simp] lemma matrix.dot_product_std_basis_one [decidable_eq n] (v : n → R) (i : n) :
  matrix.dot_product v (linear_map.std_basis R (λ _, R) i 1) = v i :=
by rw [matrix.dot_product_std_basis_eq_mul, mul_one]

lemma matrix.dot_product_eq
  (v w : n → R) (h : ∀ u, matrix.dot_product v u = matrix.dot_product w u) : v = w :=
begin
  funext x,
  classical,
  rw [← matrix.dot_product_std_basis_one v x, ← matrix.dot_product_std_basis_one w x, h],
end

lemma matrix.dot_product_eq_iff {v w : n → R} :
  (∀ u, matrix.dot_product v u = matrix.dot_product w u) ↔ v = w :=
⟨λ h, matrix.dot_product_eq v w h, λ h _, h ▸ rfl⟩

lemma matrix.dot_product_eq_zero (v : n → R) (h : ∀ w, matrix.dot_product v w = 0) : v = 0 :=
matrix.dot_product_eq _ _ $ λ u, (h u).symm ▸ (zero_dot_product u).symm

lemma matrix.dot_product_eq_zero_iff {v : n → R} : (∀ w, matrix.dot_product v w = 0) ↔ v = 0 :=
⟨λ h, matrix.dot_product_eq_zero v h, λ h w, h.symm ▸ zero_dot_product w⟩

end

namespace matrix

variables {m n : Type*} [decidable_eq n] [fintype n] [decidable_eq m] [fintype m]
variables {R : Type v} [comm_ring R]

lemma det_to_block (M : matrix m m R) (p : m → Prop) [decidable_pred p] :
  M.det = (matrix.from_blocks (to_block M p p) (to_block M p (λ j, ¬p j))
    (to_block M (λ j, ¬p j) p) (to_block M (λ j, ¬p j) (λ j, ¬p j))).det :=
begin
  rw ← matrix.det_reindex_self (equiv.sum_compl p).symm M,
  rw [det_apply', det_apply'],
  congr, ext σ, congr, ext,
  generalize hy : σ x = y,
  cases x; cases y;
  simp only [matrix.reindex_apply, to_block_apply, equiv.symm_symm,
    equiv.sum_compl_apply_inr, equiv.sum_compl_apply_inl,
    from_blocks_apply₁₁, from_blocks_apply₁₂, from_blocks_apply₂₁, from_blocks_apply₂₂,
    matrix.minor_apply],
end

lemma det_to_square_block (M : matrix m m R) {n : nat} (b : m → fin n) (k : fin n) :
  (to_square_block M b k).det = (to_square_block_prop M (λ i, b i = k)).det :=
by simp

lemma det_to_square_block' (M : matrix m m R) (b : m → ℕ) (k : ℕ) :
  (to_square_block' M b k).det = (to_square_block_prop M (λ i, b i = k)).det :=
by simp

lemma two_block_triangular_det (M : matrix m m R) (p : m → Prop) [decidable_pred p]
  (h : ∀ i (h1 : ¬p i) j (h2 : p j), M i j = 0) :
  M.det = (to_square_block_prop M p).det * (to_square_block_prop M (λ i, ¬p i)).det :=
begin
  rw det_to_block M p,
  convert upper_two_block_triangular_det (to_block M p p) (to_block M p (λ j, ¬p j))
    (to_block M (λ j, ¬p j) (λ j, ¬p j)),
  ext,
  exact h ↑i i.2 ↑j j.2
end

lemma equiv_block_det (M : matrix m m R) {p q : m → Prop} [decidable_pred p] [decidable_pred q]
  (e : ∀x, q x ↔ p x) : (to_square_block_prop M p).det = (to_square_block_prop M q).det :=
by convert matrix.det_reindex_self (equiv.subtype_equiv_right e) (to_square_block_prop M q)

lemma to_square_block_det'' (M : matrix m m R) {n : nat} (b : m → fin n) (k : fin n) :
  (to_square_block M b k).det = (to_square_block' M (λ i, ↑(b i)) ↑k).det :=
begin
  rw [to_square_block_def', to_square_block_def],
  apply equiv_block_det,
  intro x,
  apply (fin.ext_iff _ _).symm
end

/-- Let `b` map rows and columns of a square matrix `M` to `n` blocks. Then
  `block_triangular_matrix' M n b` says the matrix is block triangular. -/
def block_triangular_matrix' {o : Type*} [fintype o] (M : matrix o o R) {n : ℕ}
  (b : o → fin n) : Prop :=
∀ i j, b j < b i → M i j = 0

lemma upper_two_block_triangular' {m n : Type*} [fintype m] [fintype n]
  (A : matrix m m R) (B : matrix m n R) (D : matrix n n R) :
  block_triangular_matrix' (from_blocks A B 0 D) (sum.elim (λ i, (0 : fin 2)) (λ j, 1)) :=
begin
  intros k1 k2 hk12,
  have h0 : ∀ (k : m ⊕ n), sum.elim (λ i, (0 : fin 2)) (λ j, 1) k = 0 → ∃ i, k = sum.inl i,
  { simp },
  have h1 : ∀ (k : m ⊕ n), sum.elim (λ i, (0 : fin 2)) (λ j, 1) k = 1 → ∃ j, k = sum.inr j,
  { simp },
  set mk1 := (sum.elim (λ i, (0 : fin 2)) (λ j, 1)) k1 with hmk1,
  set mk2 := (sum.elim (λ i, (0 : fin 2)) (λ j, 1)) k2 with hmk2,
  fin_cases mk1; fin_cases mk2; rw [h, h_1] at hk12,
  { exact absurd hk12 (nat.not_lt_zero 0) },
  { exact absurd hk12 (by norm_num) },
  { rw hmk1 at h,
    obtain ⟨i, hi⟩ := h1 k1 h,
    rw hmk2 at h_1,
    obtain ⟨j, hj⟩ := h0 k2 h_1,
    rw [hi, hj], simp },
  { exact absurd hk12 (irrefl 1) }
end

/-- Let `b` map rows and columns of a square matrix `M` to blocks indexed by `ℕ`s. Then
  `block_triangular_matrix M n b` says the matrix is block triangular. -/
def block_triangular_matrix {o : Type*} [fintype o] (M : matrix o o R) (b : o → ℕ) : Prop :=
∀ i j, b j < b i → M i j = 0

lemma upper_two_block_triangular {m n : Type*} [fintype m] [fintype n]
  (A : matrix m m R) (B : matrix m n R) (D : matrix n n R) :
  block_triangular_matrix (from_blocks A B 0 D) (sum.elim (λ i, 0) (λ j, 1)) :=
begin
  intros k1 k2 hk12,
  have h01 : ∀ (k : m ⊕ n), sum.elim (λ i, 0) (λ j, 1) k = 0 ∨ sum.elim (λ i, 0) (λ j, 1) k = 1,
  { simp },
  have h0 : ∀ (k : m ⊕ n), sum.elim (λ i, 0) (λ j, 1) k = 0 → ∃ i, k = sum.inl i, { simp },
  have h1 : ∀ (k : m ⊕ n), sum.elim (λ i, 0) (λ j, 1) k = 1 → ∃ j, k = sum.inr j, { simp },
  cases (h01 k1) with hk1 hk1; cases (h01 k2) with hk2 hk2; rw [hk1, hk2] at hk12,
  { exact absurd hk12 (nat.not_lt_zero 0) },
  { exact absurd hk12 (nat.not_lt_zero 1) },
  { obtain ⟨i, hi⟩ := h1 k1 hk1,
    obtain ⟨j, hj⟩ := h0 k2 hk2,
    rw [hi, hj], simp },
  { exact absurd hk12 (irrefl 1) }
end

lemma det_of_block_triangular_matrix (M : matrix m m R) (b : m → ℕ)
  (h : block_triangular_matrix M b) :
  ∀ (n : ℕ) (hn : ∀ i, b i < n), M.det = ∏ k in finset.range n, (to_square_block' M b k).det :=
begin
  intros n hn,
  tactic.unfreeze_local_instances,
  induction n with n hi generalizing m M b,
  { rw finset.prod_range_zero,
    apply det_eq_one_of_card_eq_zero,
    apply fintype.card_eq_zero_iff.mpr,
    intro i,
    exact nat.not_lt_zero (b i) (hn i) },
  { rw [finset.prod_range_succ_comm],
    have h2 : (M.to_square_block_prop (λ (i : m), b i = n.succ)).det =
      (M.to_square_block' b n.succ).det,
    { dunfold to_square_block', dunfold to_square_block_prop, refl },
    rw two_block_triangular_det M (λ i, ¬(b i = n)),
    { rw mul_comm,
      apply congr (congr_arg has_mul.mul _),
      { let m' := {a // ¬b a = n },
        let b' := (λ (i : m'), b ↑i),
        have h' :
          block_triangular_matrix (M.to_square_block_prop (λ (i : m), ¬b i = n)) b',
        { intros i j, apply h ↑i ↑j },
        have hni : ∀ (i : {a // ¬b a = n}), b' i < n,
        { exact λ i, (ne.le_iff_lt i.property).mp (nat.lt_succ_iff.mp (hn ↑i)) },
        have h1 := hi (M.to_square_block_prop (λ (i : m), ¬b i = n)) b' h' hni,
        rw ←fin.prod_univ_eq_prod_range at h1 ⊢,
        convert h1,
        ext k,
        simp only [to_square_block_def', to_square_block_def],
        let he : {a // b' a = ↑k} ≃ {a // b a = ↑k},
        { have hc : ∀ (i : m), (λ a, b a = ↑k) i → (λ a, ¬b a = n) i,
          { intros i hbi, rw hbi, exact ne_of_lt (fin.is_lt k) },
          exact equiv.subtype_subtype_equiv_subtype hc },
        exact matrix.det_reindex_self he (λ (i j : {a // b' a = ↑k}), M ↑i ↑j) },
      { rw det_to_square_block' M b n,
        have hh : ∀ a, b a = n ↔ ¬(λ (i : m), ¬b i = n) a,
        { intro i, simp only [not_not] },
        exact equiv_block_det M hh }},
    { intros i hi j hj,
      apply (h i), simp only [not_not] at hi,
      rw hi,
      exact (ne.le_iff_lt hj).mp (nat.lt_succ_iff.mp (hn j)) }}
end

lemma det_of_block_triangular_matrix'' (M : matrix m m R) (b : m → ℕ)
  (h : block_triangular_matrix M b) :
  M.det = ∏ k in finset.image b finset.univ, (to_square_block' M b k).det :=
begin
  let n : ℕ := (Sup (finset.image b finset.univ : set ℕ)).succ,
  have hn : ∀ i, b i < n,
  { have hbi : ∀ i, b i ∈ finset.image b finset.univ, { simp },
    intro i,
    dsimp only [n],
    apply nat.lt_succ_iff.mpr,
    exact le_cSup (finset.bdd_above _) (hbi i) },
  rw det_of_block_triangular_matrix M b h n hn,
  refine (finset.prod_subset _ _).symm,
  { intros a ha, apply finset.mem_range.mpr,
    obtain ⟨i, ⟨hi, hbi⟩⟩ := finset.mem_image.mp ha,
    rw ←hbi,
    exact hn i },
  { intros k hk hbk,
    apply det_eq_one_of_card_eq_zero,
    apply fintype.card_eq_zero_iff.mpr,
    simp only [subtype.forall],
    intros a hba, apply hbk,
    apply finset.mem_image.mpr,
    use a,
    exact ⟨finset.mem_univ a, hba⟩ }
end

lemma det_of_block_triangular_matrix' (M : matrix m m R) {n : ℕ} (b : m → fin n)
  (h : block_triangular_matrix' M b) :
  M.det = ∏ (k : fin n), (to_square_block M b k).det :=
begin
  let b2 : m → ℕ := λ i, ↑(b i),
  simp_rw to_square_block_det'',
  rw fin.prod_univ_eq_prod_range (λ (k : ℕ), (M.to_square_block' b2 k).det) n,
  apply det_of_block_triangular_matrix,
  { intros i j hij, exact h i j (fin.coe_fin_lt.mp hij) },
  { intro i, exact fin.is_lt (b i) }
end

lemma det_of_upper_triangular {n : ℕ} (M : matrix (fin n) (fin n) R)
  (h : ∀ (i j : fin n), j < i → M i j = 0) :
  M.det = ∏ i : (fin n), M i i :=
begin
  convert det_of_block_triangular_matrix' M id h,
  ext i,
  have h2 : ∀ (j : {a // id a = i}), j = ⟨i, rfl⟩ :=
    λ (j : {a // id a = i}), subtype.ext j.property,
  haveI : unique {a // id a = i} := ⟨⟨⟨i, rfl⟩⟩, h2⟩,
  simp [h2 (default {a // id a = i})]
end

lemma det_of_lower_triangular {n : ℕ} (M : matrix (fin n) (fin n) R)
  (h : ∀ (i j : fin n), i < j → M i j = 0) :
  M.det = ∏ i : (fin n), M i i :=
begin
  rw ← det_transpose,
  exact det_of_upper_triangular _ (λ (i j : fin n) (hji : j < i), h j i hji)
end

end matrix


/-
Copyright (c) 2014 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro, Yaël Dillies, Patrick Stevens
-/
import algebra.order.field
import data.nat.cast

/-!
# Cast of naturals into fields

This file concerns the canonical homomorphism `ℕ → F`, where `F` is a field.

## Main results

 * `nat.cast_div`: if `n` divides `m`, then `↑(m / n) = ↑m / ↑n`
 * `nat.cast_div_le`: in all cases, `↑(m / n) ≤ ↑m / ↑ n`
-/

namespace nat

variables {α : Type*}

@[simp] theorem cast_div [field α] {m n : ℕ} (n_dvd : n ∣ m) (n_nonzero : (n : α) ≠ 0) :
  ((m / n : ℕ) : α) = m / n :=
begin
  rcases n_dvd with ⟨k, rfl⟩,
  have : n ≠ 0, {rintro rfl, simpa using n_nonzero},
  rw [nat.mul_div_cancel_left _ this.bot_lt, cast_mul, mul_div_cancel_left _ n_nonzero],
end

section linear_ordered_semifield
variables [linear_ordered_semifield α]

/-- Natural division is always less than division in the field. -/
lemma cast_div_le {m n : ℕ} : ((m / n : ℕ) : α) ≤ m / n :=
begin
  cases n,
  { rw [cast_zero, div_zero, nat.div_zero, cast_zero] },
  rwa [le_div_iff, ←nat.cast_mul],
  exact nat.cast_le.2 (nat.div_mul_le_self m n.succ),
  { exact nat.cast_pos.2 n.succ_pos }
end

lemma inv_pos_of_nat {n : ℕ} : 0 < ((n : α) + 1)⁻¹ :=
inv_pos.2 $ add_pos_of_nonneg_of_pos n.cast_nonneg zero_lt_one

lemma one_div_pos_of_nat {n : ℕ} : 0 < 1 / ((n : α) + 1) :=
by { rw one_div, exact inv_pos_of_nat }

lemma one_div_le_one_div {n m : ℕ} (h : n ≤ m) : 1 / ((m : α) + 1) ≤ 1 / ((n : α) + 1) :=
by { refine one_div_le_one_div_of_le _ _, exact nat.cast_add_one_pos _, simpa }

lemma one_div_lt_one_div {n m : ℕ} (h : n < m) : 1 / ((m : α) + 1) < 1 / ((n : α) + 1) :=
by { refine one_div_lt_one_div_of_lt _ _, exact nat.cast_add_one_pos _, simpa }

end linear_ordered_semifield
end nat


/-
References:

https://www.cambridge.org/core/books/handbook-of-practical-logic-and-automated-reasoning/EB6396296813CB562987E8C37AC4520D
https://www.cl.cam.ac.uk/~jrh13/atp/index.html
Harrison, J. (2009).
Handbook of Practical Logic and Automated Reasoning.
Cambridge: Cambridge University Press.
doi:10.1017/CBO9780511576430
-/

import data.set

/-
Formula schemes.
atom "P" : A formula scheme variable named "P".
-/
@[derive decidable_eq] inductive formula : Type
| bottom : formula
| top : formula
| atom : string → formula
| not : formula → formula
| and : formula → formula → formula
| or : formula → formula → formula
| imp : formula → formula → formula
| iff : formula → formula → formula

open formula

meta def formula.repr : formula → string
| bottom := sformat!"F"
| top := sformat!"T"
| (atom x) := x.quote
| (not p) := sformat!"(¬ {p.repr})"
| (and p q) := sformat!"({p.repr} ∧ {q.repr})"
| (or p q) := sformat!"({p.repr} ∨ {q.repr})"
| (imp p q) := sformat!"({p.repr} → {q.repr})"
| (iff p q) := sformat!"({p.repr} ↔ {q.repr})"
meta instance : has_repr formula := has_repr.mk formula.repr

def valuation := string → bool

def eval : formula → valuation → bool
| bottom _ := ff
| top _ := tt
| (atom x) m := m x
| (not p) m := !(eval p m)
| (and p q) m := (eval p m) && (eval q m)
| (or p q) m := (eval p m) || (eval q m)
| (imp p q) m := (!(eval p m)) || (eval q m)
| (iff p q) m := (eval p m) = (eval q m)

def atoms : formula → set string
| bottom := {}
| top := {}
| (atom x) := {x}
| (not p) := atoms p
| (and p q) := (atoms p) ∪ (atoms q)
| (or p q) := (atoms p) ∪ (atoms q)
| (imp p q) := (atoms p) ∪ (atoms q)
| (iff p q) := (atoms p) ∪ (atoms q)

theorem thm_2_1
  (p : formula) :
  set.finite (atoms p) :=
begin
  induction p,
  case bottom { unfold atoms, exact set.finite_empty},
  case top { unfold atoms, exact set.finite_empty},
  case atom : x { unfold atoms, exact set.finite_singleton x },
  case not : p ih_p { unfold atoms, exact ih_p },
  case and : p q ih_p ih_q { unfold atoms, exact set.finite.union ih_p ih_q },
  case or : p q ih_p ih_q { unfold atoms, exact set.finite.union ih_p ih_q },
  case imp : p q ih_p ih_q { unfold atoms, exact set.finite.union ih_p ih_q },
  case iff : p q ih_p ih_q { unfold atoms, exact set.finite.union ih_p ih_q },
end

theorem thm_2_2
  (p : formula)
  (v v' : valuation)
  (h1 : ∀ x ∈ (atoms p), v x = v' x) :
  eval p v = eval p v' :=
begin
  induction p,
  case bottom : { reflexivity },
  case top : { reflexivity },
  case atom : x { unfold eval, apply h1 x, unfold atoms, simp only [set.mem_singleton] },
  case not : p ih {
    unfold eval, unfold atoms at h1,
    have s1 : eval p v = eval p v', apply ih, exact h1,
    rewrite s1 },
  case and : p q ih_p ih_q {
    unfold eval, unfold atoms at h1, simp only [set.mem_union_eq] at h1,
    have s1 : eval p v = eval p v', apply ih_p, intros x h2, apply h1, left, exact h2,
    have s2 : eval q v = eval q v', apply ih_q, intros x h2, apply h1, right, exact h2,
    rewrite s1, rewrite s2 },
  case or : p q ih_p ih_q {
    unfold eval, unfold atoms at h1, simp only [set.mem_union_eq] at h1,
    have s1 : eval p v = eval p v', apply ih_p, intros x h2, apply h1, left, exact h2,
    have s2 : eval q v = eval q v', apply ih_q, intros x h2, apply h1, right, exact h2,
    rewrite s1, rewrite s2 },
  case imp : p q ih_p ih_q {
    unfold eval, unfold atoms at h1, simp only [set.mem_union_eq] at h1,
    have s1 : eval p v = eval p v', apply ih_p, intros x h2, apply h1, left, exact h2,
    have s2 : eval q v = eval q v', apply ih_q, intros x h2, apply h1, right, exact h2,
    rewrite s1, rewrite s2 },
  case iff : p q ih_p ih_q {
    unfold eval, unfold atoms at h1, simp only [set.mem_union_eq] at h1,
    have s1 : eval p v = eval p v', apply ih_p, intros x h2, apply h1, left, exact h2,
    have s2 : eval q v = eval q v', apply ih_q, intros x h2, apply h1, right, exact h2,
    rewrite s1, rewrite s2 }
end

def sub : (string → formula) → formula → formula
| _ bottom := bottom
| _ top := top
| f (atom x) := f x
| f (not p) := not (sub f p)
| f (and p q) := and (sub f p) (sub f q)
| f (or p q) := or (sub f p) (sub f q)
| f (imp p q) := imp (sub f p) (sub f q)
| f (iff p q) := iff (sub f p) (sub f q)

theorem thm_2_3_gen
  (p : formula)
  (f : string → formula)
  (v : valuation) :
  eval (sub f p) v = eval p (fun i, eval (f i) v) :=
begin
  induction p,
  case bottom { reflexivity },
  case top { reflexivity },
  case atom : x { reflexivity },
  case not : p ih_p { unfold sub, unfold eval, rewrite ih_p },
  case and : p q ih_p ih_q { unfold sub, unfold eval, rewrite ih_p, rewrite ih_q },
  case or : p q ih_p ih_q { unfold sub, unfold eval, rewrite ih_p, rewrite ih_q },
  case imp : p q ih_p ih_q { unfold sub, unfold eval, rewrite ih_p, rewrite ih_q },
  case iff : p q ih_p ih_q { unfold sub, unfold eval, rewrite ih_p, rewrite ih_q }
end

notation  x `↦` a := fun v, function.update v x a

theorem thm_2_3
  (x : string)
  (p q : formula)
  (v : valuation) :
  eval (sub ((x ↦ q) atom) p) v =
    eval p ((x ↦ (eval q v)) v) :=
begin
  rewrite thm_2_3_gen,
  congr, ext p,
  simp [function.update]; split_ifs; simp [eval]
end

def is_tauto (p : formula) : Prop := ∀ v : valuation, eval p v = tt

theorem thm_2_4_gen
  (p : formula)
  (h1 : is_tauto p)
  (f : string → formula) :
  is_tauto (sub f p) :=
begin
  unfold is_tauto at *,
  intros v,
  rewrite thm_2_3_gen, apply h1
end

theorem thm_2_4
  (p : formula)
  (h1 : is_tauto p)
  (x : string)
  (q : formula) :
  is_tauto (sub ((x ↦ q) atom) p) :=
begin
  apply thm_2_4_gen _ h1
end

theorem thm_2_5
  (v : valuation)
  (p q : formula)
  (h1 : eval p v = eval q v)
  (x : string)
  (r : formula) :
  eval (sub ((x ↦ p) atom) r) v =
    eval (sub ((x ↦ q) atom) r) v :=
begin
  rewrite [thm_2_3, thm_2_3, h1]
end

theorem eval_not
  (p : formula)
  (v : valuation) :
  eval (not p) v = tt ↔ ¬ (eval p v = tt) :=
begin
  unfold eval, cases eval p v; exact dec_trivial
end

theorem eval_imp
  (p q : formula)
  (v : valuation) :
  eval (imp p q) v = tt ↔ ((eval p v = tt) → (eval q v = tt)) :=
begin
  unfold eval, cases eval p v; cases eval q v; exact dec_trivial
end

theorem is_tauto_mp
  (p q : formula)
  (h1 : is_tauto p)
  (h2 : is_tauto (p.imp q)) :
  is_tauto q :=
begin
  unfold is_tauto at *,
  intro v,
  simp only [eval_imp] at h2,
  apply h2, apply h1
end

theorem is_tauto_prop_1
(p q : formula) :
is_tauto (p.imp (q.imp p)) :=
begin
  unfold is_tauto,
  intro v,
  simp only [eval_imp],
  intros h1 h2,
  exact h1
end

theorem is_tauto_prop_2
  (p q r : formula) :
  is_tauto ((p.imp (q.imp r)).imp ((p.imp q).imp (p.imp r))) :=
begin
  unfold is_tauto,
  intro v,
  simp only [eval_imp],
  intros h1 h2 h3,
  apply h1, exact h3, apply h2, exact h3
end

theorem is_tauto_prop_3
(p q : formula) :
is_tauto (((not p).imp (not q)).imp (q.imp p)) :=
begin
  unfold is_tauto,
  intro v,
  simp only [eval_not, eval_imp],
  intros h1 h2,
  by_contradiction, apply h1, exact h, exact h2
end


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

import data.bracket
import group_theory.subgroup.basic
import tactic.group

/-!
# General commutators.

If `G` is a group and `H₁ H₂ : subgroup G` then the general commutator `⁅H₁, H₂⁆ : subgroup G`
is the subgroup of `G` generated by the commutators `h₁ * h₂ * h₁⁻¹ * h₂⁻¹`.

## Main definitions

* `general_commutator H₁ H₂` : the commutator of the subgroups `H₁` and `H₂`
-/

open subgroup

variables {G G' : Type*} [group G] [group G'] {f : G →* G'}

/-- The commutator of two subgroups `H₁` and `H₂`. -/
instance general_commutator : has_bracket (subgroup G) (subgroup G) :=
⟨λ H₁ H₂, closure {x | ∃ (p ∈ H₁) (q ∈ H₂), p * q * p⁻¹ * q⁻¹ = x}⟩

lemma general_commutator_def (H₁ H₂ : subgroup G) :
  ⁅H₁, H₂⁆ = closure {x | ∃ (p ∈ H₁) (q ∈ H₂), p * q * p⁻¹ * q⁻¹ = x} := rfl

instance general_commutator_normal (H₁ H₂ : subgroup G) [h₁ : H₁.normal]
  [h₂ : H₂.normal] : normal ⁅H₁, H₂⁆ :=
begin
  let base : set G := {x | ∃ (p ∈ H₁) (q ∈ H₂), p * q * p⁻¹ * q⁻¹ = x},
  suffices h_base : base = group.conjugates_of_set base,
  { dsimp only [general_commutator_def, ←base],
    rw h_base,
    exact subgroup.normal_closure_normal },
  apply set.subset.antisymm group.subset_conjugates_of_set,
  intros a h,
  simp_rw [group.mem_conjugates_of_set_iff, is_conj_iff] at h,
  rcases h with ⟨b, ⟨c, hc, e, he, rfl⟩, d, rfl⟩,
  exact ⟨d * c * d⁻¹, h₁.conj_mem c hc d, d * e * d⁻¹, h₂.conj_mem e he d, by group⟩,
end

lemma general_commutator_mono {H₁ H₂ K₁ K₂ : subgroup G} (h₁ : H₁ ≤ K₁) (h₂ : H₂ ≤ K₂) :
  ⁅H₁, H₂⁆ ≤ ⁅K₁, K₂⁆ :=
begin
  apply closure_mono,
  rintros x ⟨p, hp, q, hq, rfl⟩,
  exact ⟨p, h₁ hp, q, h₂ hq, rfl⟩,
end

lemma general_commutator_def' (H₁ H₂ : subgroup G) [H₁.normal] [H₂.normal] :
  ⁅H₁, H₂⁆ = normal_closure {x | ∃ (p ∈ H₁) (q ∈ H₂), p * q * p⁻¹ * q⁻¹ = x} :=
by rw [← normal_closure_eq_self ⁅H₁, H₂⁆, general_commutator_def,
  normal_closure_closure_eq_normal_closure]

lemma general_commutator_le (H₁ H₂ : subgroup G) (K : subgroup G) :
  ⁅H₁, H₂⁆ ≤ K ↔ ∀ (p ∈ H₁) (q ∈ H₂), p * q * p⁻¹ * q⁻¹ ∈ K :=
begin
  rw [general_commutator, closure_le],
  split,
  { intros h p hp q hq,
    exact h ⟨p, hp, q, hq, rfl⟩, },
  { rintros h x ⟨p, hp, q, hq, rfl⟩,
    exact h p hp q hq, }
end

lemma general_commutator_containment (H₁ H₂ : subgroup G) {p q : G} (hp : p ∈ H₁) (hq : q ∈ H₂) :
  p * q * p⁻¹ * q⁻¹ ∈ ⁅H₁, H₂⁆ :=
(general_commutator_le H₁ H₂ ⁅H₁, H₂⁆).mp (le_refl ⁅H₁, H₂⁆) p hp q hq

lemma general_commutator_comm (H₁ H₂ : subgroup G) : ⁅H₁, H₂⁆ = ⁅H₂, H₁⁆ :=
begin
  suffices : ∀ H₁ H₂ : subgroup G, ⁅H₁, H₂⁆ ≤ ⁅H₂, H₁⁆, { exact le_antisymm (this _ _) (this _ _) },
  intros H₁ H₂,
  rw general_commutator_le,
  intros p hp q hq,
  have h : (p * q * p⁻¹ * q⁻¹)⁻¹ ∈ ⁅H₂, H₁⁆ := subset_closure ⟨q, hq, p, hp, by group⟩,
  convert inv_mem ⁅H₂, H₁⁆ h,
  group,
end

lemma general_commutator_le_right (H₁ H₂ : subgroup G) [h : normal H₂] :
  ⁅H₁, H₂⁆ ≤ H₂ :=
begin
  rw general_commutator_le,
  intros p hp q hq,
  exact mul_mem H₂ (h.conj_mem q hq p) (inv_mem H₂ hq),
end

lemma general_commutator_le_left (H₁ H₂ : subgroup G) [h : normal H₁] :
  ⁅H₁, H₂⁆ ≤ H₁ :=
begin
  rw general_commutator_comm,
  exact general_commutator_le_right H₂ H₁,
end

@[simp] lemma general_commutator_bot (H : subgroup G) : ⁅H, ⊥⁆ = (⊥ : subgroup G) :=
by { rw eq_bot_iff, exact general_commutator_le_right H ⊥ }

@[simp] lemma bot_general_commutator (H : subgroup G) : ⁅(⊥ : subgroup G), H⁆ = (⊥ : subgroup G) :=
by { rw eq_bot_iff, exact general_commutator_le_left ⊥ H }

lemma general_commutator_le_inf (H₁ H₂ : subgroup G) [normal H₁] [normal H₂] :
  ⁅H₁, H₂⁆ ≤ H₁ ⊓ H₂ :=
by simp only [general_commutator_le_left, general_commutator_le_right, le_inf_iff, and_self]


/-
Copyright (c) 2015 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Leonardo de Moura

Tuples are lists of a fixed size.
It is implemented as a subtype.

! This file was ported from Lean 3 source module data.vector
! leanprover-community/mathlib commit 78b8dbdf66ac8db31afa8fe3d0d7f1d0bf1be236
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
prelude
import Leanbin.Init.Data.List.Default
import Leanbin.Init.Data.Subtype.Default
import Leanbin.Init.Meta.Interactive
import Leanbin.Init.Data.Fin.Default

universe u v w

#print Vector /-
def Vector (α : Type u) (n : ℕ) :=
  { l : List α // l.length = n }
#align vector Vector
-/

namespace Vector

variable {α : Type u} {β : Type v} {φ : Type w}

variable {n : ℕ}

instance [DecidableEq α] : DecidableEq (Vector α n) := by unfold Vector; infer_instance

#print Vector.nil /-
@[match_pattern]
def nil : Vector α 0 :=
  ⟨[], rfl⟩
#align vector.nil Vector.nil
-/

#print Vector.cons /-
@[match_pattern]
def cons : α → Vector α n → Vector α (Nat.succ n)
  | a, ⟨v, h⟩ => ⟨a :: v, congr_arg Nat.succ h⟩
#align vector.cons Vector.cons
-/

#print Vector.length /-
@[reducible]
def length (v : Vector α n) : ℕ :=
  n
#align vector.length Vector.length
-/

open Nat

#print Vector.head /-
def head : Vector α (Nat.succ n) → α
  | ⟨[], h⟩ => by contradiction
  | ⟨a :: v, h⟩ => a
#align vector.head Vector.head
-/

#print Vector.head_cons /-
theorem head_cons (a : α) : ∀ v : Vector α n, head (cons a v) = a
  | ⟨l, h⟩ => rfl
#align vector.head_cons Vector.head_cons
-/

#print Vector.tail /-
def tail : Vector α n → Vector α (n - 1)
  | ⟨[], h⟩ => ⟨[], congr_arg pred h⟩
  | ⟨a :: v, h⟩ => ⟨v, congr_arg pred h⟩
#align vector.tail Vector.tail
-/

#print Vector.tail_cons /-
theorem tail_cons (a : α) : ∀ v : Vector α n, tail (cons a v) = v
  | ⟨l, h⟩ => rfl
#align vector.tail_cons Vector.tail_cons
-/

#print Vector.cons_head_tail /-
@[simp]
theorem cons_head_tail : ∀ v : Vector α (succ n), cons (head v) (tail v) = v
  | ⟨[], h⟩ => by contradiction
  | ⟨a :: v, h⟩ => rfl
#align vector.cons_head_tail Vector.cons_head_tail
-/

#print Vector.toList /-
def toList (v : Vector α n) : List α :=
  v.1
#align vector.to_list Vector.toList
-/

#print Vector.get /-
def get : ∀ v : Vector α n, Fin n → α
  | ⟨l, h⟩, i => l.nthLe i.1 (by rw [h] <;> exact i.2)
#align vector.nth Vector.get
-/

#print Vector.append /-
def append {n m : Nat} : Vector α n → Vector α m → Vector α (n + m)
  | ⟨l₁, h₁⟩, ⟨l₂, h₂⟩ => ⟨l₁ ++ l₂, by simp [*]⟩
#align vector.append Vector.append
-/

#print Vector.elim /-
@[elab_as_elim]
def elim {α} {C : ∀ {n}, Vector α n → Sort u} (H : ∀ l : List α, C ⟨l, rfl⟩) {n : Nat} :
    ∀ v : Vector α n, C v
  | ⟨l, h⟩ =>
    match n, h with
    | _, rfl => H l
#align vector.elim Vector.elim
-/

#print Vector.map /-
-- map
def map (f : α → β) : Vector α n → Vector β n
  | ⟨l, h⟩ => ⟨List.map f l, by simp [*]⟩
#align vector.map Vector.map
-/

#print Vector.map_nil /-
@[simp]
theorem map_nil (f : α → β) : map f nil = nil :=
  rfl
#align vector.map_nil Vector.map_nil
-/

#print Vector.map_cons /-
theorem map_cons (f : α → β) (a : α) : ∀ v : Vector α n, map f (cons a v) = cons (f a) (map f v)
  | ⟨l, h⟩ => rfl
#align vector.map_cons Vector.map_cons
-/

#print Vector.map₂ /-
def map₂ (f : α → β → φ) : Vector α n → Vector β n → Vector φ n
  | ⟨x, _⟩, ⟨y, _⟩ => ⟨List.zipWith f x y, by simp [*]⟩
#align vector.map₂ Vector.map₂
-/

def repeat (a : α) (n : ℕ) : Vector α n :=
  ⟨List.repeat a n, List.length_repeat a n⟩
#align vector.repeat Vector.repeat

#print Vector.drop /-
def drop (i : ℕ) : Vector α n → Vector α (n - i)
  | ⟨l, p⟩ => ⟨List.drop i l, by simp [*]⟩
#align vector.drop Vector.drop
-/

/- warning: vector.take -> Vector.take is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {n : Nat} (i : Nat), (Vector.{u1} α n) -> (Vector.{u1} α (LinearOrder.min.{0} Nat Nat.linearOrder i n))
but is expected to have type
  forall {α : Type.{u1}} {n : Nat} (i : Nat), (Vector.{u1} α n) -> (Vector.{u1} α (Min.min.{0} Nat instMinNat i n))
Case conversion may be inaccurate. Consider using '#align vector.take Vector.takeₓ'. -/
def take (i : ℕ) : Vector α n → Vector α (min i n)
  | ⟨l, p⟩ => ⟨List.take i l, by simp [*]⟩
#align vector.take Vector.take

#print Vector.removeNth /-
def removeNth (i : Fin n) : Vector α n → Vector α (n - 1)
  | ⟨l, p⟩ => ⟨List.removeNth l i.1, by rw [l.length_remove_nth i.1] <;> rw [p] <;> exact i.2⟩
#align vector.remove_nth Vector.removeNth
-/

#print Vector.ofFn /-
def ofFn : ∀ {n}, (Fin n → α) → Vector α n
  | 0, f => nil
  | n + 1, f => cons (f 0) (of_fn fun i => f i.succ)
#align vector.of_fn Vector.ofFn
-/

section Accum

open Prod

variable {σ : Type}

#print Vector.mapAccumr /-
def mapAccumr (f : α → σ → σ × β) : Vector α n → σ → σ × Vector β n
  | ⟨x, px⟩, c =>
    let res := List.mapAccumr f x c
    ⟨res.1, res.2, by simp [*]⟩
#align vector.map_accumr Vector.mapAccumr
-/

#print Vector.mapAccumr₂ /-
def mapAccumr₂ {α β σ φ : Type} (f : α → β → σ → σ × φ) :
    Vector α n → Vector β n → σ → σ × Vector φ n
  | ⟨x, px⟩, ⟨y, py⟩, c =>
    let res := List.mapAccumr₂ f x y c
    ⟨res.1, res.2, by simp [*]⟩
#align vector.map_accumr₂ Vector.mapAccumr₂
-/

end Accum

#print Vector.eq /-
protected theorem eq {n : ℕ} : ∀ a1 a2 : Vector α n, toList a1 = toList a2 → a1 = a2
  | ⟨x, h1⟩, ⟨_, h2⟩, rfl => rfl
#align vector.eq Vector.eq
-/

#print Vector.eq_nil /-
protected theorem eq_nil (v : Vector α 0) : v = nil :=
  v.Eq nil (List.eq_nil_of_length_eq_zero v.2)
#align vector.eq_nil Vector.eq_nil
-/

#print Vector.toList_mk /-
@[simp]
theorem toList_mk (v : List α) (P : List.length v = n) : toList (Subtype.mk v P) = v :=
  rfl
#align vector.to_list_mk Vector.toList_mk
-/

#print Vector.toList_nil /-
@[simp]
theorem toList_nil : toList nil = @List.nil α :=
  rfl
#align vector.to_list_nil Vector.toList_nil
-/

#print Vector.toList_length /-
@[simp]
theorem toList_length (v : Vector α n) : (toList v).length = n :=
  v.2
#align vector.to_list_length Vector.toList_length
-/

#print Vector.toList_cons /-
@[simp]
theorem toList_cons (a : α) (v : Vector α n) : toList (cons a v) = a :: toList v := by cases v; rfl
#align vector.to_list_cons Vector.toList_cons
-/

#print Vector.toList_append /-
@[simp]
theorem toList_append {n m : Nat} (v : Vector α n) (w : Vector α m) :
    toList (append v w) = toList v ++ toList w := by cases v; cases w; rfl
#align vector.to_list_append Vector.toList_append
-/

#print Vector.toList_drop /-
@[simp]
theorem toList_drop {n m : ℕ} (v : Vector α m) : toList (drop n v) = List.drop n (toList v) := by
  cases v; rfl
#align vector.to_list_drop Vector.toList_drop
-/

#print Vector.toList_take /-
@[simp]
theorem toList_take {n m : ℕ} (v : Vector α m) : toList (take n v) = List.take n (toList v) := by
  cases v; rfl
#align vector.to_list_take Vector.toList_take
-/

end Vector


import algebra.ring
import tactic
import order.bounded_lattice
/--
##  It's the group functor  idem,
##  e1 × e2 = e1 e2 + (1-e1)(1-e2)
-/
structure idem (R : Type ) [comm_ring R] :=
(e : R)
(certif : e * e = e)

namespace idem

variables {R : Type} [comm_ring R]

/-! extension lemma : E = E' ↔  E.e = E'.e -/
@[ext] lemma ext : ∀ {g1 g2 : idem R}, g1.e = g2.e → g1 = g2
| ⟨_, _⟩ ⟨_, _⟩ := λ h, by congr; exact h

-- add a coercion from `idem R` to `R`
instance : has_coe (idem R) R := ⟨e⟩

-- Now if `E : idem R` you can just talk about `E : R` and this is the same as `↑E : R`
-- You don't have to put `E.e` any more

@[simp] theorem certif_def (E : idem R) : (E : R) * E = E := E.certif

def bot : idem R := {e := 0, certif := mul_zero 0}

instance : has_bot (idem R) := ⟨bot⟩

def inf (E F : idem R) : idem R :=
{ e := E * F,
  certif := by rw [(show ((E : R) * F) * (E * F) = E * E * (F * F), by ring), E.certif_def, F.certif_def]
}

-- `\glb` notation ⊓
instance : has_inf (idem R) := ⟨inf⟩

lemma inf_comm {E F : idem R} : E ⊓ F = F ⊓ E := by ext; apply mul_comm

@[simp] lemma inf_def (E F : idem R) : (↑(E ⊓ F) : R) = E * F := rfl

def le (E F : idem R) := E ⊓ F = E

-- ≤ notation
instance : has_le (idem R) := ⟨le⟩

@[simp] theorem le_def (E F : idem R) : E ≤ F ↔ (E : R) * F = E :=
⟨λ h, begin change E ⊓ F = E at h, show (E ⊓ F).e = E.e, rw h end, @ext _ _ (E ⊓ F) E⟩

instance : partial_order (idem R) :=
{ le := (≤),
  le_refl := λ E, begin ext, exact E.certif end,
  le_trans := λ E F G hEF hFG, begin
    ext,
    show (E : R) * G = E,
    rw le_def at hEF hFG,
    suffices : (E : R) * F * G = E,
    { rwa hEF at this},
    rw [mul_assoc, hFG, hEF],
  end,
  le_antisymm := λ E F hEF hFE, begin
    change E ⊓ F = E at hEF,
    rw [←hEF, inf_comm],
    exact hFE
  end }

lemma bot_le {E : idem R} : ⊥ ≤ E :=
begin
  ext,
  exact zero_mul _,
end

lemma inf_le_left {E F : idem R} : E ⊓ F ≤ E :=
begin
  suffices : (E : R) * F * E = E * F,
    simpa using this,
  rw [mul_comm, ←mul_assoc, E.certif_def],
end

lemma inf_le_right {E F : idem R} : E ⊓ F ≤ F := by rw [inf_comm]; apply inf_le_left

lemma le_inf {E F G : idem R} (hEF : E ≤ F) (hEG : E ≤ G) : E ≤ F ⊓ G :=
begin
  suffices : (E : R) * (F * G) = E,
    simpa using this,
  rw le_def at hEF hEG,
  rw [←mul_assoc, hEF, hEG],
end

instance : order_bot (idem R) :=
{ bot_le := λ _, bot_le, ..idem.has_bot, ..idem.partial_order}

instance : semilattice_inf_bot (idem R) :=
{ inf_le_left := λ _ _, inf_le_left,
  inf_le_right := λ _ _, inf_le_right,
  le_inf := λ _ _ _, le_inf,
  ..idem.has_inf, ..idem.order_bot
}

-- Should automation generate semilattice_sup_top instance
-- after this definition of inv,
-- and inv_inv and le_of_inv_le_inv?

def inv (E : idem R) : idem R :=
{ e := 1 - E,
  certif := begin
    rw [(show ((1 : R) - E) * (1 - E) = 1 - 2 * E + E * E, by ring), certif_def],
    ring,
  end
}

-- ⁻¹ notation for `inv`
instance : has_inv (idem R) := ⟨inv⟩

@[simp] theorem inv_def (E : idem R) : (↑E⁻¹ : R) = 1 - E := rfl

@[simp] theorem inv_inv (E : idem R) : E⁻¹⁻¹ = E :=
begin
  cases E with e he,
  ext,
  show 1 - (1 - e) = e,
  ring,
end

theorem eq_of_inv_eq (E F : idem R) : E⁻¹ = F⁻¹ → E = F :=
begin
  intro h,
  rw ←inv_inv E,
  rw h,
  exact inv_inv F
end

theorem le_of_inv_le_inv (E F : idem R) : E⁻¹ ≤ F⁻¹ → F ≤ E :=
begin
  intro h,
  rw le_def at h ⊢,
  have h2 : ((1 : R) - E) * (1 - F) = 1 - E,
    simpa using h,
  rw [show ((1 : R) - E) * (1 - F) = F * E - (E + F - 1), by ring, sub_eq_iff_eq_add] at h2,
  rw h2,
  ring
end

theorem inv_le_inv_of_le {E F : idem R} : E ≤ F → F⁻¹ ≤ E⁻¹ :=
begin
  intro h,
  apply le_of_inv_le_inv,
  simp [h],
end

-- I want the next part to be automatically generated
def sup (E F : idem R) := (F⁻¹ ⊓ E⁻¹)⁻¹

-- ⊔ notation (\lub)
instance : has_sup (idem R) := ⟨sup⟩

@[simp] theorem sup_def (E F : idem R) : E ⊔ F = (F⁻¹ ⊓ E⁻¹)⁻¹ := rfl

def top : idem R := ⊥⁻¹

-- ⊤ notation (\top)
instance : has_top (idem R) := ⟨top⟩

@[simp] theorem top_def : (⊤ : idem R) = ⊥⁻¹ := rfl

@[simp] theorem inv_top : (⊤ : idem R)⁻¹ = ⊥ :=
begin
  apply eq_of_inv_eq,
  simp,
end

theorem le_top {E : idem R} : E ≤ ⊤ :=
begin
  apply le_of_inv_le_inv,
  convert bot_le,
  simp,
end

instance : order_top (idem R) :=
{ le_top := λ _, le_top, ..idem.has_top, ..idem.partial_order}

-- a machine could write these
instance: semilattice_sup_top (idem R) :=
{ le_sup_left := λ E F, begin
    apply le_of_inv_le_inv,
    rw sup_def,
    rw inv_inv,
    apply inf_le_right,
  end,
  le_sup_right := λ E F, begin
    apply le_of_inv_le_inv,
    rw sup_def,
    rw inv_inv,
    apply inf_le_left,
  end,
  sup_le := λ E F G hEF hFG, begin
    apply le_of_inv_le_inv,
    rw sup_def,
    rw inv_inv,
    apply le_inf (inv_le_inv_of_le hFG) (inv_le_inv_of_le hEF),
  end,
  ..idem.has_sup, ..idem.order_top
}

instance : bounded_lattice (idem R) :=
{
  ..idem.semilattice_inf_bot, ..idem.semilattice_sup_top
}


/-
Copyright (c) 2022 Anatole Dedecker. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Anatole Dedecker
-/
import topology.uniform_space.uniform_convergence_topology
import analysis.locally_convex.bounded
import topology.algebra.filter_basis

/-!
# Algebraic facts about the topology of uniform convergence

This file contains algebraic compatibility results about the uniform structure of uniform
convergence / `𝔖`-convergence. They will mostly be useful for defining strong topologies on the
space of continuous linear maps between two topological vector spaces.

## Main statements

* `uniform_fun.uniform_group` : if `G` is a uniform group, then `α →ᵤ G` a uniform group
* `uniform_on_fun.uniform_group` : if `G` is a uniform group, then for any `𝔖 : set (set α)`,
  `α →ᵤ[𝔖] G` a uniform group.
* `uniform_on_fun.has_continuous_smul_of_image_bounded` : let `E` be a TVS, `𝔖 : set (set α)` and
  `H` a submodule of `α →ᵤ[𝔖] E`. If the image of any `S ∈ 𝔖` by any `u ∈ H` is bounded (in the
  sense of `bornology.is_vonN_bounded`), then `H`, equipped with the topology induced from
  `α →ᵤ[𝔖] E`, is a TVS.

## Implementation notes

Like in `topology/uniform_space/uniform_convergence_topology`, we use the type aliases
`uniform_fun` (denoted `α →ᵤ β`) and `uniform_on_fun` (denoted `α →ᵤ[𝔖] β`) for functions from `α`
to `β` endowed with the structures of uniform convergence and `𝔖`-convergence.

## TODO

* `uniform_on_fun.has_continuous_smul_of_image_bounded` unnecessarily asks for `𝔖` to be
  nonempty and directed. This will be easy to solve once we know that replacing `𝔖` by its
  ***noncovering*** bornology (i.e ***not*** what `bornology` currently refers to in mathlib)
  doesn't change the topology.

## References

* [N. Bourbaki, *General Topology, Chapter X*][bourbaki1966]
* [N. Bourbaki, *Topological Vector Spaces*][bourbaki1987]

## Tags

uniform convergence, strong dual

-/

open filter
open_locale topology pointwise uniform_convergence

section algebraic_instances

variables {α β ι R : Type*} {𝔖 : set $ set α}

@[to_additive] instance [monoid β] : monoid (α →ᵤ β) := pi.monoid
@[to_additive] instance [monoid β] : monoid (α →ᵤ[𝔖] β) := pi.monoid

@[to_additive] instance [comm_monoid β] : comm_monoid (α →ᵤ β) := pi.comm_monoid
@[to_additive] instance [comm_monoid β] : comm_monoid (α →ᵤ[𝔖] β) := pi.comm_monoid

@[to_additive] instance [group β] : group (α →ᵤ β) := pi.group
@[to_additive] instance [group β] : group (α →ᵤ[𝔖] β) := pi.group

@[to_additive] instance [comm_group β] : comm_group (α →ᵤ β) := pi.comm_group
@[to_additive] instance [comm_group β] : comm_group (α →ᵤ[𝔖] β) := pi.comm_group

instance [semiring R] [add_comm_monoid β] [module R β] : module R (α →ᵤ β) := pi.module _ _ _
instance [semiring R] [add_comm_monoid β] [module R β] : module R (α →ᵤ[𝔖] β) := pi.module _ _ _

end algebraic_instances

section group

variables {α G ι : Type*} [group G] {𝔖 : set $ set α} [uniform_space G] [uniform_group G]

/-- If `G` is a uniform group, then `α →ᵤ G` is a uniform group as well. -/
@[to_additive "If `G` is a uniform additive group, then `α →ᵤ G` is a uniform additive group
as well."]
instance : uniform_group (α →ᵤ G) :=
-- Since `(/) : G × G → G` is uniformly continuous,
-- `uniform_fun.postcomp_uniform_continuous` tells us that
-- `((/) ∘ —) : (α →ᵤ G × G) → (α →ᵤ G)` is uniformly continuous too. By precomposing with
-- `uniform_fun.uniform_equiv_prod_arrow`, this gives that
-- `(/) : (α →ᵤ G) × (α →ᵤ G) → (α →ᵤ G)` is also uniformly continuous
⟨(uniform_fun.postcomp_uniform_continuous uniform_continuous_div).comp
  uniform_fun.uniform_equiv_prod_arrow.symm.uniform_continuous⟩

@[to_additive]
protected lemma uniform_fun.has_basis_nhds_one_of_basis {p : ι → Prop}
  {b : ι → set G} (h : (𝓝 1 : filter G).has_basis p b) :
  (𝓝 1 : filter (α →ᵤ G)).has_basis p
    (λ i, {f : α →ᵤ G | ∀ x, f x ∈ b i}) :=
begin
  have := h.comap (λ p : G × G, p.2 / p.1),
  rw ← uniformity_eq_comap_nhds_one at this,
  convert uniform_fun.has_basis_nhds_of_basis α _ 1 this,
  ext i f,
  simp [uniform_fun.gen]
end

@[to_additive]
protected lemma uniform_fun.has_basis_nhds_one :
  (𝓝 1 : filter (α →ᵤ G)).has_basis
    (λ V : set G, V ∈ (𝓝 1 : filter G))
    (λ V, {f : α → G | ∀ x, f x ∈ V}) :=
uniform_fun.has_basis_nhds_one_of_basis (basis_sets _)

/-- Let `𝔖 : set (set α)`. If `G` is a uniform group, then `α →ᵤ[𝔖] G` is a uniform group as
well. -/
@[to_additive "Let `𝔖 : set (set α)`. If `G` is a uniform additive group, then `α →ᵤ[𝔖] G` is a
uniform additive group as well. "]
instance : uniform_group (α →ᵤ[𝔖] G) :=
-- Since `(/) : G × G → G` is uniformly continuous,
-- `uniform_on_fun.postcomp_uniform_continuous` tells us that
-- `((/) ∘ —) : (α →ᵤ[𝔖] G × G) → (α →ᵤ[𝔖] G)` is uniformly continuous too. By precomposing with
-- `uniform_on_fun.uniform_equiv_prod_arrow`, this gives that
-- `(/) : (α →ᵤ[𝔖] G) × (α →ᵤ[𝔖] G) → (α →ᵤ[𝔖] G)` is also uniformly continuous
⟨(uniform_on_fun.postcomp_uniform_continuous uniform_continuous_div).comp
  uniform_on_fun.uniform_equiv_prod_arrow.symm.uniform_continuous⟩

@[to_additive]
protected lemma uniform_on_fun.has_basis_nhds_one_of_basis (𝔖 : set $ set α)
  (h𝔖₁ : 𝔖.nonempty) (h𝔖₂ : directed_on (⊆) 𝔖) {p : ι → Prop}
  {b : ι → set G} (h : (𝓝 1 : filter G).has_basis p b) :
  (𝓝 1 : filter (α →ᵤ[𝔖] G)).has_basis
    (λ Si : set α × ι, Si.1 ∈ 𝔖 ∧ p Si.2)
    (λ Si, {f : α →ᵤ[𝔖] G | ∀ x ∈ Si.1, f x ∈ b Si.2}) :=
begin
  have := h.comap (λ p : G × G, p.1 / p.2),
  rw ← uniformity_eq_comap_nhds_one_swapped at this,
  convert uniform_on_fun.has_basis_nhds_of_basis α _ 𝔖 1 h𝔖₁ h𝔖₂ this,
  ext i f,
  simp [uniform_on_fun.gen]
end

@[to_additive]
protected lemma uniform_on_fun.has_basis_nhds_one (𝔖 : set $ set α)
  (h𝔖₁ : 𝔖.nonempty) (h𝔖₂ : directed_on (⊆) 𝔖) :
  (𝓝 1 : filter (α →ᵤ[𝔖] G)).has_basis
    (λ SV : set α × set G, SV.1 ∈ 𝔖 ∧ SV.2 ∈ (𝓝 1 : filter G))
    (λ SV, {f : α →ᵤ[𝔖] G | ∀ x ∈ SV.1, f x ∈ SV.2}) :=
uniform_on_fun.has_basis_nhds_one_of_basis 𝔖 h𝔖₁ h𝔖₂ (basis_sets _)

end group

section module

variables (𝕜 α E H : Type*) {hom : Type*} [normed_field 𝕜] [add_comm_group H] [module 𝕜 H]
  [add_comm_group E] [module 𝕜 E] [topological_space H] [uniform_space E] [uniform_add_group E]
  [has_continuous_smul 𝕜 E] {𝔖 : set $ set α} [linear_map_class hom 𝕜 H (α →ᵤ[𝔖] E)]

/-- Let `E` be a TVS, `𝔖 : set (set α)` and `H` a submodule of `α →ᵤ[𝔖] E`. If the image of any
`S ∈ 𝔖` by any `u ∈ H` is bounded (in the sense of `bornology.is_vonN_bounded`), then `H`,
equipped with the topology of `𝔖`-convergence, is a TVS.

For convenience, we don't literally ask for `H : submodule (α →ᵤ[𝔖] E)`. Instead, we prove the
result for any vector space `H` equipped with a linear inducing to `α →ᵤ[𝔖] E`, which is often
easier to use. We also state the `submodule` version as
`uniform_on_fun.has_continuous_smul_submodule_of_image_bounded`. -/
lemma uniform_on_fun.has_continuous_smul_induced_of_image_bounded
  (h𝔖₁ : 𝔖.nonempty) (h𝔖₂ : directed_on (⊆) 𝔖)
  (φ : hom) (hφ : inducing φ)
  (h : ∀ u : H, ∀ s ∈ 𝔖, bornology.is_vonN_bounded 𝕜 ((φ u : α → E) '' s)) :
  has_continuous_smul 𝕜 H :=
begin
  haveI : topological_add_group H,
  { rw hφ.induced,
    exact topological_add_group_induced φ },
  have : (𝓝 0 : filter H).has_basis _ _,
  { rw [hφ.induced, nhds_induced, map_zero],
    exact ((uniform_on_fun.has_basis_nhds_zero 𝔖 h𝔖₁ h𝔖₂).comap φ) },
  refine has_continuous_smul.of_basis_zero this _ _ _,
  { rintros ⟨S, V⟩ ⟨hS, hV⟩,
    have : tendsto (λ kx : (𝕜 × E), kx.1 • kx.2) (𝓝 (0, 0)) (𝓝 $ (0 : 𝕜) • 0) :=
      continuous_smul.tendsto (0 : 𝕜 × E),
    rw [zero_smul, nhds_prod_eq] at this,
    have := this hV,
    rw [mem_map, mem_prod_iff] at this,
    rcases this with ⟨U, hU, W, hW, hUW⟩,
    refine ⟨U, hU, ⟨S, W⟩, ⟨hS, hW⟩, _⟩,
    rw set.smul_subset_iff,
    intros a ha u hu x hx,
    rw smul_hom_class.map_smul,
    exact hUW (⟨ha, hu x hx⟩ : (a, φ u x) ∈ U ×ˢ W) },
  { rintros a ⟨S, V⟩ ⟨hS, hV⟩,
    have : tendsto (λ x : E, a • x) (𝓝 0) (𝓝 $ a • 0) := tendsto_id.const_smul a,
    rw [smul_zero] at this,
    refine ⟨⟨S, ((•) a) ⁻¹' V⟩, ⟨hS, this hV⟩, λ f hf x hx, _⟩,
    rw [smul_hom_class.map_smul],
    exact hf x hx },
  { rintros u ⟨S, V⟩ ⟨hS, hV⟩,
    rcases h u S hS hV with ⟨r, hrpos, hr⟩,
    rw metric.eventually_nhds_iff_ball,
    refine ⟨r⁻¹, inv_pos.mpr hrpos, λ a ha x hx, _⟩,
    by_cases ha0 : a = 0,
    { rw ha0,
      simp [mem_of_mem_nhds hV] },
    { rw mem_ball_zero_iff at ha,
      rw [smul_hom_class.map_smul, pi.smul_apply],
      have : φ u x ∈ a⁻¹ • V,
      { have ha0 : 0<‖a‖ := norm_pos_iff.mpr ha0,
        refine (hr a⁻¹ _) (set.mem_image_of_mem (φ u) hx),
        rw [norm_inv, le_inv hrpos ha0],
        exact ha.le },
      rwa set.mem_inv_smul_set_iff₀ ha0 at this } }
end

/-- Let `E` be a TVS, `𝔖 : set (set α)` and `H` a submodule of `α →ᵤ[𝔖] E`. If the image of any
`S ∈ 𝔖` by any `u ∈ H` is bounded (in the sense of `bornology.is_vonN_bounded`), then `H`,
equipped with the topology of `𝔖`-convergence, is a TVS.

If you have a hard time using this lemma, try the one above instead. -/
lemma uniform_on_fun.has_continuous_smul_submodule_of_image_bounded
  (h𝔖₁ : 𝔖.nonempty) (h𝔖₂ : directed_on (⊆) 𝔖) (H : submodule 𝕜 (α →ᵤ[𝔖] E))
  (h : ∀ u ∈ H, ∀ s ∈ 𝔖, bornology.is_vonN_bounded 𝕜 (u '' s)) :
  @has_continuous_smul 𝕜 H _ _
  ((uniform_on_fun.topological_space α E 𝔖).induced (coe : H → α →ᵤ[𝔖] E)) :=
begin
  haveI : topological_add_group H := topological_add_group_induced
    (linear_map.id.dom_restrict H : H →ₗ[𝕜] α → E),
  exact uniform_on_fun.has_continuous_smul_induced_of_image_bounded 𝕜 α E H h𝔖₁ h𝔖₂
    (linear_map.id.dom_restrict H : H →ₗ[𝕜] α → E) inducing_coe (λ ⟨u, hu⟩, h u hu)
end

end module