/-
Copyright (c) 2020 Robert Y. Lewis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Robert Y. Lewis
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.meta.rb_map
import Mathlib.tactic.ring
import Mathlib.tactic.linarith.lemmas
import Mathlib.PostPort

universes l

namespace Mathlib

/-!
# Datatypes for `linarith`

Some of the data structures here are used in multiple parts of the tactic.
We split them into their own file.

This file also contains a few convenient auxiliary functions.
-/

namespace linarith

/-- A shorthand for tracing when the `trace.linarith` option is set to true. -/
/--
A shorthand for tracing the types of a list of proof terms
when the `trace.linarith` option is set to true.
-/
/-! ### Linear expressions -/

/--
A linear expression is a list of pairs of variable indices and coefficients,
representing the sum of the products of each coefficient with its corresponding variable.

Some functions on `linexp` assume that `n : ℕ` occurs at most once as the first element of a pair,
and that the list is sorted in decreasing order of the first argument.
This is not enforced by the type but the operations here preserve it.
-/
def linexp := List (ℕ × ℤ)

namespace linexp

/--
Add two `linexp`s together componentwise.
Preserves sorting and uniqueness of the first argument.
-/
/-- `l.scale c` scales the values in `l` by `c` without modifying the order or keys. -/
def scale (c : ℤ) (l : linexp) : linexp :=
  ite (c = 0) [] (ite (c = 1) l (list.map (fun (_x : ℕ × ℤ) => sorry) l))

/--
`l.get n` returns the value in `l` associated with key `n`, if it exists, and `none` otherwise.
This function assumes that `l` is sorted in decreasing order of the first argument,
that is, it will return `none` as soon as it finds a key smaller than `n`.
-/
def get (n : ℕ) : linexp → Option ℤ := sorry

/--
`l.contains n` is true iff `n` is the first element of a pair in `l`.
-/
def contains (n : ℕ) : linexp → Bool := option.is_some ∘ get n

/--
`l.zfind n` returns the value associated with key `n` if there is one, and 0 otherwise.
-/
def zfind (n : ℕ) (l : linexp) : ℤ := sorry

/-- `l.vars` returns the list of variables that occur in `l`. -/
def vars (l : linexp) : List ℕ := list.map prod.fst l

/--
Defines a lex ordering on `linexp`. This function is performance critical.
-/
def cmp : linexp → linexp → ordering := sorry

end linexp

/-! ### Inequalities -/

/-- The three-element type `ineq` is used to represent the strength of a comparison between terms. -/
inductive ineq where
| eq : ineq
| le : ineq
| lt : ineq

namespace ineq

/--
`max R1 R2` computes the strength of the sum of two inequalities. If `t1 R1 0` and `t2 R2 0`,
then `t1 + t2 (max R1 R2) 0`.
-/
def max : ineq → ineq → ineq := sorry

/-- `ineq` is ordered `eq < le < lt`. -/
def cmp : ineq → ineq → ordering := sorry

/-- Prints an `ineq` as the corresponding infix symbol. -/
def to_string : ineq → string := sorry

/-- Finds the name of a multiplicative lemma corresponding to an inequality strength. -/
protected instance has_to_string : has_to_string ineq := has_to_string.mk to_string

end ineq

/-! ### Comparisons with 0 -/

/--
The main datatype for FM elimination.
Variables are represented by natural numbers, each of which has an integer coefficient.
Index 0 is reserved for constants, i.e. `coeffs.find 0` is the coefficient of 1.
The represented term is `coeffs.sum (λ ⟨k, v⟩, v * Var[k])`.
str determines the strength of the comparison -- is it < 0, ≤ 0, or = 0?
-/
structure comp where
  str : ineq
  coeffs : linexp

/-- `c.vars` returns the list of variables that appear in the linear expression contained in `c`. -/
def comp.vars : comp → List ℕ := linexp.vars ∘ comp.coeffs

/-- `comp.coeff_of c a` projects the coefficient of variable `a` out of `c`. -/
def comp.coeff_of (c : comp) (a : ℕ) : ℤ := linexp.zfind a (comp.coeffs c)

/-- `comp.scale c n` scales the coefficients of `c` by `n`. -/
def comp.scale (c : comp) (n : ℕ) : comp := comp.mk (comp.str c) (linexp.scale (↑n) (comp.coeffs c))

/--
`comp.add c1 c2` adds the expressions represented by `c1` and `c2`.
The coefficient of variable `a` in `c1.add c2`
is the sum of the coefficients of `a` in `c1` and `c2`.
 -/
/-- `comp` has a lex order. First the `ineq`s are compared, then the `coeff`s. -/
/--
A `comp` represents a contradiction if its expression has no coefficients and its strength is <,
that is, it represents the fact `0 < 0`.
 -/
/-! ### Parsing into linear form -/

/-! ### Control -/

/--
A preprocessor transforms a proof of a proposition into a proof of a different propositon.
The return type is `list expr`, since some preprocessing steps may create multiple new hypotheses,
and some may remove a hypothesis from the list.
A "no-op" preprocessor should return its input as a singleton list.
-/
/--
Some preprocessors need to examine the full list of hypotheses instead of working item by item.
As with `preprocessor`, the input to a `global_preprocessor` is replaced by, not added to, its output.
-/
/--
Some preprocessors perform branching case splits. A `branch` is used to track one of these case
splits. The first component, an `expr`, is the goal corresponding to this branch of the split,
given as a metavariable. The `list expr` component is the list of hypotheses for `linarith`
in this branch. Every `expr` in this list should be type correct in the context of the associated goal.
-/
/--
Some preprocessors perform branching case splits.
A `global_branching_preprocessor` produces a list of branches to run.
Each branch is independent, so hypotheses that appear in multiple branches should be duplicated.
The preprocessor is responsible for making sure that each branch contains the correct goal
metavariable.
-/
/--
A `preprocessor` lifts to a `global_preprocessor` by folding it over the input list.
-/
/--
A `global_preprocessor` lifts to a `global_branching_preprocessor` by producing only one branch.
-/
/--
`process pp l` runs `pp.transform` on `l` and returns the result,
tracing the result if `trace.linarith` is on.
-/
/--
A `certificate_oracle` is a function `produce_certificate : list comp → ℕ → tactic (rb_map ℕ ℕ)`.
`produce_certificate hyps max_var` tries to derive a contradiction from the comparisons in `hyps`
by eliminating all variables ≤ `max_var`.
If successful, it returns a map `coeff : ℕ → ℕ` as a certificate.
This map represents that we can find a contradiction by taking the sum  `∑ (coeff i) * hyps[i]`.

The default `certificate_oracle` used by `linarith` is `linarith.fourier_motzkin.produce_certificate`
-/
/-- A configuration object for `linarith`. -/
end Mathlib


/-
Copyright (c) 2018 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro, Johannes Hölzl, Sander Dahmen, Scott Morrison

! This file was ported from Lean 3 source module linear_algebra.dimension
! leanprover-community/mathlib commit 2196ab363eb097c008d4497125e0dde23fb36db2
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.Module.BigOperators
import Mathbin.LinearAlgebra.Dfinsupp
import Mathbin.LinearAlgebra.InvariantBasisNumber
import Mathbin.LinearAlgebra.Isomorphisms
import Mathbin.LinearAlgebra.StdBasis
import Mathbin.SetTheory.Cardinal.Cofinality

/-!
# Dimension of modules and vector spaces

## Main definitions

* The rank of a module is defined as `module.rank : cardinal`.
  This is defined as the supremum of the cardinalities of linearly independent subsets.

* The rank of a linear map is defined as the rank of its range.

## Main statements

* `linear_map.dim_le_of_injective`: the source of an injective linear map has dimension
  at most that of the target.
* `linear_map.dim_le_of_surjective`: the target of a surjective linear map has dimension
  at most that of that source.
* `basis_fintype_of_finite_spans`:
  the existence of a finite spanning set implies that any basis is finite.
* `infinite_basis_le_maximal_linear_independent`:
  if `b` is an infinite basis for a module `M`,
  and `s` is a maximal linearly independent set,
  then the cardinality of `b` is bounded by the cardinality of `s`.

For modules over rings satisfying the rank condition

* `basis.le_span`:
  the cardinality of a basis is bounded by the cardinality of any spanning set

For modules over rings satisfying the strong rank condition

* `linear_independent_le_span`:
  For any linearly independent family `v : ι → M`
  and any finite spanning set `w : set M`,
  the cardinality of `ι` is bounded by the cardinality of `w`.
* `linear_independent_le_basis`:
  If `b` is a basis for a module `M`,
  and `s` is a linearly independent set,
  then the cardinality of `s` is bounded by the cardinality of `b`.

For modules over rings with invariant basis number
(including all commutative rings and all noetherian rings)

* `mk_eq_mk_of_basis`: the dimension theorem, any two bases of the same vector space have the same
  cardinality.

For vector spaces (i.e. modules over a field), we have

* `dim_quotient_add_dim`: if `V₁` is a submodule of `V`, then
  `module.rank (V/V₁) + module.rank V₁ = module.rank V`.
* `dim_range_add_dim_ker`: the rank-nullity theorem.

## Implementation notes

There is a naming discrepancy: most of the theorem names refer to `dim`,
even though the definition is of `module.rank`.
This reflects that `module.rank` was originally called `dim`, and only defined for vector spaces.

Many theorems in this file are not universe-generic when they relate dimensions
in different universes. They should be as general as they can be without
inserting `lift`s. The types `V`, `V'`, ... all live in different universes,
and `V₁`, `V₂`, ... all live in the same universe.
-/

noncomputable section

universe u v v' v'' u₁' w w'

variable {K : Type u} {V V₁ V₂ V₃ : Type v} {V' V'₁ : Type v'} {V'' : Type v''}

variable {ι : Type w} {ι' : Type w'} {η : Type u₁'} {φ : η → Type _}

open Classical BigOperators Cardinal

open Basis Submodule Function Set

section Module

section

variable [Semiring K] [AddCommMonoid V] [Module K V]

include K

variable (K V)

/-- The rank of a module, defined as a term of type `cardinal`.

We define this as the supremum of the cardinalities of linearly independent subsets.

For a free module over any ring satisfying the strong rank condition
(e.g. left-noetherian rings, commutative rings, and in particular division rings and fields),
this is the same as the dimension of the space (i.e. the cardinality of any basis).

In particular this agrees with the usual notion of the dimension of a vector space.

The definition is marked as protected to avoid conflicts with `_root_.rank`,
the rank of a linear map.
-/
protected irreducible_def Module.rank : Cardinal :=
  ⨆ ι : { s : Set V // LinearIndependent K (coe : s → V) }, #ι.1
#align module.rank Module.rank

end

section

variable {R : Type u} [Ring R]

variable {M : Type v} [AddCommGroup M] [Module R M]

variable {M' : Type v'} [AddCommGroup M'] [Module R M']

variable {M₁ : Type v} [AddCommGroup M₁] [Module R M₁]

theorem LinearMap.lift_dim_le_of_injective (f : M →ₗ[R] M') (i : Injective f) :
    Cardinal.lift.{v'} (Module.rank R M) ≤ Cardinal.lift.{v} (Module.rank R M') :=
  by
  dsimp [Module.rank]
  rw [Cardinal.lift_supᵢ (Cardinal.bddAbove_range.{v', v'} _),
    Cardinal.lift_supᵢ (Cardinal.bddAbove_range.{v, v} _)]
  apply csupᵢ_mono' (Cardinal.bddAbove_range.{v', v} _)
  rintro ⟨s, li⟩
  refine' ⟨⟨f '' s, _⟩, cardinal.lift_mk_le'.mpr ⟨(Equiv.Set.image f s i).toEmbedding⟩⟩
  exact (li.map' _ <| linear_map.ker_eq_bot.mpr i).image
#align linear_map.lift_dim_le_of_injective LinearMap.lift_dim_le_of_injective

theorem LinearMap.dim_le_of_injective (f : M →ₗ[R] M₁) (i : Injective f) :
    Module.rank R M ≤ Module.rank R M₁ :=
  Cardinal.lift_le.1 (f.lift_dim_le_of_injective i)
#align linear_map.dim_le_of_injective LinearMap.dim_le_of_injective

theorem dim_le {n : ℕ}
    (H : ∀ s : Finset M, (LinearIndependent R fun i : s => (i : M)) → s.card ≤ n) :
    Module.rank R M ≤ n := by
  rw [Module.rank]
  apply csupᵢ_le'
  rintro ⟨s, li⟩
  exact linearIndependent_bounded_of_finset_linearIndependent_bounded H _ li
#align dim_le dim_le

theorem lift_dim_range_le (f : M →ₗ[R] M') :
    Cardinal.lift.{v} (Module.rank R f.range) ≤ Cardinal.lift.{v'} (Module.rank R M) :=
  by
  dsimp [Module.rank]
  rw [Cardinal.lift_supᵢ (Cardinal.bddAbove_range.{v', v'} _)]
  apply csupᵢ_le'
  rintro ⟨s, li⟩
  apply le_trans
  swap
  apply cardinal.lift_le.mpr
  refine' le_csupᵢ (Cardinal.bddAbove_range.{v, v} _) ⟨range_splitting f '' s, _⟩
  · apply LinearIndependent.of_comp f.range_restrict
    convert li.comp (Equiv.Set.rangeSplittingImageEquiv f s) (Equiv.injective _) using 1
  · exact (cardinal.lift_mk_eq'.mpr ⟨Equiv.Set.rangeSplittingImageEquiv f s⟩).ge
#align lift_dim_range_le lift_dim_range_le

theorem dim_range_le (f : M →ₗ[R] M₁) : Module.rank R f.range ≤ Module.rank R M := by
  simpa using lift_dim_range_le f
#align dim_range_le dim_range_le

theorem lift_dim_map_le (f : M →ₗ[R] M') (p : Submodule R M) :
    Cardinal.lift.{v} (Module.rank R (p.map f)) ≤ Cardinal.lift.{v'} (Module.rank R p) :=
  by
  have h := lift_dim_range_le (f.comp (Submodule.subtype p))
  rwa [LinearMap.range_comp, range_subtype] at h
#align lift_dim_map_le lift_dim_map_le

theorem dim_map_le (f : M →ₗ[R] M₁) (p : Submodule R M) :
    Module.rank R (p.map f) ≤ Module.rank R p := by simpa using lift_dim_map_le f p
#align dim_map_le dim_map_le

theorem dim_le_of_submodule (s t : Submodule R M) (h : s ≤ t) : Module.rank R s ≤ Module.rank R t :=
  (ofLe h).dim_le_of_injective fun ⟨x, hx⟩ ⟨y, hy⟩ eq =>
    Subtype.eq <| show x = y from Subtype.ext_iff_val.1 Eq
#align dim_le_of_submodule dim_le_of_submodule

/-- Two linearly equivalent vector spaces have the same dimension, a version with different
universes. -/
theorem LinearEquiv.lift_dim_eq (f : M ≃ₗ[R] M') :
    Cardinal.lift.{v'} (Module.rank R M) = Cardinal.lift.{v} (Module.rank R M') :=
  by
  apply le_antisymm
  · exact f.to_linear_map.lift_dim_le_of_injective f.injective
  · exact f.symm.to_linear_map.lift_dim_le_of_injective f.symm.injective
#align linear_equiv.lift_dim_eq LinearEquiv.lift_dim_eq

/-- Two linearly equivalent vector spaces have the same dimension. -/
theorem LinearEquiv.dim_eq (f : M ≃ₗ[R] M₁) : Module.rank R M = Module.rank R M₁ :=
  Cardinal.lift_inj.1 f.lift_dim_eq
#align linear_equiv.dim_eq LinearEquiv.dim_eq

theorem dim_eq_of_injective (f : M →ₗ[R] M₁) (h : Injective f) :
    Module.rank R M = Module.rank R f.range :=
  (LinearEquiv.ofInjective f h).dim_eq
#align dim_eq_of_injective dim_eq_of_injective

/-- Pushforwards of submodules along a `linear_equiv` have the same dimension. -/
theorem LinearEquiv.dim_map_eq (f : M ≃ₗ[R] M₁) (p : Submodule R M) :
    Module.rank R (p.map (f : M →ₗ[R] M₁)) = Module.rank R p :=
  (f.submoduleMap p).dim_eq.symm
#align linear_equiv.dim_map_eq LinearEquiv.dim_map_eq

variable (R M)

@[simp]
theorem dim_top : Module.rank R (⊤ : Submodule R M) = Module.rank R M :=
  by
  have : (⊤ : Submodule R M) ≃ₗ[R] M := LinearEquiv.ofTop ⊤ rfl
  rw [this.dim_eq]
#align dim_top dim_top

variable {R M}

theorem dim_range_of_surjective (f : M →ₗ[R] M') (h : Surjective f) :
    Module.rank R f.range = Module.rank R M' := by rw [LinearMap.range_eq_top.2 h, dim_top]
#align dim_range_of_surjective dim_range_of_surjective

theorem dim_submodule_le (s : Submodule R M) : Module.rank R s ≤ Module.rank R M :=
  by
  rw [← dim_top R M]
  exact dim_le_of_submodule _ _ le_top
#align dim_submodule_le dim_submodule_le

theorem LinearMap.dim_le_of_surjective (f : M →ₗ[R] M₁) (h : Surjective f) :
    Module.rank R M₁ ≤ Module.rank R M :=
  by
  rw [← dim_range_of_surjective f h]
  apply dim_range_le
#align linear_map.dim_le_of_surjective LinearMap.dim_le_of_surjective

theorem dim_quotient_le (p : Submodule R M) : Module.rank R (M ⧸ p) ≤ Module.rank R M :=
  (mkQ p).dim_le_of_surjective (surjective_quot_mk _)
#align dim_quotient_le dim_quotient_le

variable [Nontrivial R]

theorem cardinal_lift_le_dim_of_linearIndependent.{m} {ι : Type w} {v : ι → M}
    (hv : LinearIndependent R v) :
    Cardinal.lift.{max v m} (#ι) ≤ Cardinal.lift.{max w m} (Module.rank R M) :=
  by
  apply le_trans
  · exact cardinal.lift_mk_le.mpr ⟨(Equiv.ofInjective _ hv.injective).toEmbedding⟩
  · simp only [Cardinal.lift_le, Module.rank]
    apply le_trans
    swap
    exact le_csupᵢ (Cardinal.bddAbove_range.{v, v} _) ⟨range v, hv.coe_range⟩
    exact le_rfl
#align cardinal_lift_le_dim_of_linear_independent cardinal_lift_le_dim_of_linearIndependent

theorem cardinal_lift_le_dim_of_linear_independent' {ι : Type w} {v : ι → M}
    (hv : LinearIndependent R v) : Cardinal.lift.{v} (#ι) ≤ Cardinal.lift.{w} (Module.rank R M) :=
  cardinal_lift_le_dim_of_linearIndependent.{u, v, w, 0} hv
#align cardinal_lift_le_dim_of_linear_independent' cardinal_lift_le_dim_of_linear_independent'

theorem cardinal_le_dim_of_linearIndependent {ι : Type v} {v : ι → M} (hv : LinearIndependent R v) :
    (#ι) ≤ Module.rank R M := by simpa using cardinal_lift_le_dim_of_linearIndependent hv
#align cardinal_le_dim_of_linear_independent cardinal_le_dim_of_linearIndependent

theorem cardinal_le_dim_of_linear_independent' {s : Set M}
    (hs : LinearIndependent R (fun x => x : s → M)) : (#s) ≤ Module.rank R M :=
  cardinal_le_dim_of_linearIndependent hs
#align cardinal_le_dim_of_linear_independent' cardinal_le_dim_of_linear_independent'

variable (R M)

@[simp]
theorem dim_pUnit : Module.rank R PUnit = 0 :=
  by
  apply le_bot_iff.mp
  rw [Module.rank]
  apply csupᵢ_le'
  rintro ⟨s, li⟩
  apply le_bot_iff.mpr
  apply cardinal.mk_emptyc_iff.mpr
  simp only [Subtype.coe_mk]
  by_contra h
  obtain ⟨a, ha⟩ := nonempty_iff_ne_empty.2 h
  simpa using LinearIndependent.ne_zero (⟨a, ha⟩ : s) li
#align dim_punit dim_pUnit

@[simp]
theorem dim_bot : Module.rank R (⊥ : Submodule R M) = 0 :=
  by
  have : (⊥ : Submodule R M) ≃ₗ[R] PUnit := bot_equiv_punit
  rw [this.dim_eq, dim_pUnit]
#align dim_bot dim_bot

variable {R M}

/-- A linearly-independent family of vectors in a module over a non-trivial ring must be finite if
the module is Noetherian. -/
theorem LinearIndependent.finite_of_isNoetherian [IsNoetherian R M] {v : ι → M}
    (hv : LinearIndependent R v) : Finite ι :=
  by
  have hwf := is_noetherian_iff_well_founded.mp (by infer_instance : IsNoetherian R M)
  refine'
    CompleteLattice.WellFounded.finite_of_independent hwf hv.independent_span_singleton
      fun i contra => _
  apply hv.ne_zero i
  have : v i ∈ R ∙ v i := Submodule.mem_span_singleton_self (v i)
  rwa [contra, Submodule.mem_bot] at this
#align linear_independent.finite_of_is_noetherian LinearIndependent.finite_of_isNoetherian

theorem LinearIndependent.set_finite_of_isNoetherian [IsNoetherian R M] {s : Set M}
    (hi : LinearIndependent R (coe : s → M)) : s.Finite :=
  @Set.toFinite _ _ hi.finite_of_isNoetherian
#align linear_independent.set_finite_of_is_noetherian LinearIndependent.set_finite_of_isNoetherian

-- One might hope that a finite spanning set implies that any linearly independent set is finite.
-- While this is true over a division ring
-- (simply because any linearly independent set can be extended to a basis),
-- I'm not certain what more general statements are possible.
/--
Over any nontrivial ring, the existence of a finite spanning set implies that any basis is finite.
-/
def basisFintypeOfFiniteSpans (w : Set M) [Fintype w] (s : span R w = ⊤) {ι : Type w}
    (b : Basis ι R M) : Fintype ι :=
  by
  -- We'll work by contradiction, assuming `ι` is infinite.
  apply fintypeOfNotInfinite _
  intro i
  -- Let `S` be the union of the supports of `x ∈ w` expressed as linear combinations of `b`.
  -- This is a finite set since `w` is finite.
  let S : Finset ι := finset.univ.sup fun x : w => (b.repr x).support
  let bS : Set M := b '' S
  have h : ∀ x ∈ w, x ∈ span R bS := by
    intro x m
    rw [← b.total_repr x, Finsupp.span_image_eq_map_total, Submodule.mem_map]
    use b.repr x
    simp only [and_true_iff, eq_self_iff_true, Finsupp.mem_supported]
    change (b.repr x).support ≤ S
    convert Finset.le_sup (by simp : (⟨x, m⟩ : w) ∈ Finset.univ)
    rfl
  -- Thus this finite subset of the basis elements spans the entire module.
  have k : span R bS = ⊤ := eq_top_iff.2 (le_trans s.ge (span_le.2 h))
  -- Now there is some `x : ι` not in `S`, since `ι` is infinite.
  obtain ⟨x, nm⟩ := Infinite.exists_not_mem_finset S
  -- However it must be in the span of the finite subset,
  have k' : b x ∈ span R bS := by
    rw [k]
    exact mem_top
  -- giving the desire contradiction.
  refine' b.linear_independent.not_mem_span_image _ k'
  exact nm
#align basis_fintype_of_finite_spans basisFintypeOfFiniteSpans

-- From [Les familles libres maximales d'un module ont-elles le meme cardinal?][lazarus1973]
/-- Over any ring `R`, if `b` is a basis for a module `M`,
and `s` is a maximal linearly independent set,
then the union of the supports of `x ∈ s` (when written out in the basis `b`) is all of `b`.
-/
theorem union_support_maximal_linearIndependent_eq_range_basis {ι : Type w} (b : Basis ι R M)
    {κ : Type w'} (v : κ → M) (i : LinearIndependent R v) (m : i.Maximal) :
    (⋃ k, ((b.repr (v k)).support : Set ι)) = univ :=
  by
  -- If that's not the case,
  by_contra h
  simp only [← Ne.def, ne_univ_iff_exists_not_mem, mem_Union, not_exists_not,
    Finsupp.mem_support_iff, Finset.mem_coe] at h
  -- We have some basis element `b b'` which is not in the support of any of the `v i`.
  obtain ⟨b', w⟩ := h
  -- Using this, we'll construct a linearly independent family strictly larger than `v`,
  -- by also using this `b b'`.
  let v' : Option κ → M := fun o => o.elim (b b') v
  have r : range v ⊆ range v' := by
    rintro - ⟨k, rfl⟩
    use some k
    rfl
  have r' : b b' ∉ range v := by
    rintro ⟨k, p⟩
    simpa [w] using congr_arg (fun m => (b.repr m) b') p
  have r'' : range v ≠ range v' := by
    intro e
    have p : b b' ∈ range v' := by
      use none
      rfl
    rw [← e] at p
    exact r' p
  have inj' : injective v' := by
    rintro (_ | k) (_ | k) z
    · rfl
    · exfalso
      exact r' ⟨k, z.symm⟩
    · exfalso
      exact r' ⟨k, z⟩
    · congr
      exact i.injective z
  -- The key step in the proof is checking that this strictly larger family is linearly independent.
  have i' : LinearIndependent R (coe : range v' → M) :=
    by
    rw [linearIndependent_subtype_range inj', linearIndependent_iff]
    intro l z
    rw [Finsupp.total_option] at z
    simp only [v', Option.elim'] at z
    change _ + Finsupp.total κ M R v l.some = 0 at z
    -- We have some linear combination of `b b'` and the `v i`, which we want to show is trivial.
    -- We'll first show the coefficient of `b b'` is zero,
    -- by expressing the `v i` in the basis `b`, and using that the `v i` have no `b b'` term.
    have l₀ : l none = 0 := by
      rw [← eq_neg_iff_add_eq_zero] at z
      replace z := neg_eq_iff_eq_neg.mpr z
      apply_fun fun x => b.repr x b'  at z
      simp only [repr_self, LinearEquiv.map_smul, mul_one, Finsupp.single_eq_same, Pi.neg_apply,
        Finsupp.smul_single', LinearEquiv.map_neg, Finsupp.coe_neg] at z
      erw [Finsupp.congr_fun (Finsupp.apply_total R (b.repr : M →ₗ[R] ι →₀ R) v l.some) b'] at z
      simpa [Finsupp.total_apply, w] using z
    -- Then all the other coefficients are zero, because `v` is linear independent.
    have l₁ : l.some = 0 := by
      rw [l₀, zero_smul, zero_add] at z
      exact linear_independent_iff.mp i _ z
    -- Finally we put those facts together to show the linear combination is trivial.
    ext (_ | a)
    · simp only [l₀, Finsupp.coe_zero, Pi.zero_apply]
    · erw [Finsupp.congr_fun l₁ a]
      simp only [Finsupp.coe_zero, Pi.zero_apply]
  dsimp [LinearIndependent.Maximal] at m
  specialize m (range v') i' r
  exact r'' m
#align union_support_maximal_linear_independent_eq_range_basis union_support_maximal_linearIndependent_eq_range_basis

/-- Over any ring `R`, if `b` is an infinite basis for a module `M`,
and `s` is a maximal linearly independent set,
then the cardinality of `b` is bounded by the cardinality of `s`.
-/
theorem infinite_basis_le_maximal_linear_independent' {ι : Type w} (b : Basis ι R M) [Infinite ι]
    {κ : Type w'} (v : κ → M) (i : LinearIndependent R v) (m : i.Maximal) :
    Cardinal.lift.{w'} (#ι) ≤ Cardinal.lift.{w} (#κ) :=
  by
  let Φ := fun k : κ => (b.repr (v k)).support
  have w₁ : (#ι) ≤ (#Set.range Φ) :=
    by
    apply Cardinal.le_range_of_union_finset_eq_top
    exact union_support_maximal_linearIndependent_eq_range_basis b v i m
  have w₂ : Cardinal.lift.{w'} (#Set.range Φ) ≤ Cardinal.lift.{w} (#κ) := Cardinal.mk_range_le_lift
  exact (cardinal.lift_le.mpr w₁).trans w₂
#align infinite_basis_le_maximal_linear_independent' infinite_basis_le_maximal_linear_independent'

-- (See `infinite_basis_le_maximal_linear_independent'` for the more general version
-- where the index types can live in different universes.)
/-- Over any ring `R`, if `b` is an infinite basis for a module `M`,
and `s` is a maximal linearly independent set,
then the cardinality of `b` is bounded by the cardinality of `s`.
-/
theorem infinite_basis_le_maximal_linearIndependent {ι : Type w} (b : Basis ι R M) [Infinite ι]
    {κ : Type w} (v : κ → M) (i : LinearIndependent R v) (m : i.Maximal) : (#ι) ≤ (#κ) :=
  Cardinal.lift_le.mp (infinite_basis_le_maximal_linear_independent' b v i m)
#align infinite_basis_le_maximal_linear_independent infinite_basis_le_maximal_linearIndependent

theorem CompleteLattice.Independent.subtype_ne_bot_le_rank [NoZeroSMulDivisors R M]
    {V : ι → Submodule R M} (hV : CompleteLattice.Independent V) :
    Cardinal.lift.{v} (#{ i : ι // V i ≠ ⊥ }) ≤ Cardinal.lift.{w} (Module.rank R M) :=
  by
  set I := { i : ι // V i ≠ ⊥ }
  have hI : ∀ i : I, ∃ v ∈ V i, v ≠ (0 : M) := by
    intro i
    rw [← Submodule.ne_bot_iff]
    exact i.prop
  choose v hvV hv using hI
  have : LinearIndependent R v := (hV.comp Subtype.coe_injective).LinearIndependent _ hvV hv
  exact cardinal_lift_le_dim_of_linear_independent' this
#align complete_lattice.independent.subtype_ne_bot_le_rank CompleteLattice.Independent.subtype_ne_bot_le_rank

end

section rank_zero

variable {R : Type u} {M : Type v}

variable [Ring R] [Nontrivial R] [AddCommGroup M] [Module R M] [NoZeroSMulDivisors R M]

theorem dim_zero_iff_forall_zero : Module.rank R M = 0 ↔ ∀ x : M, x = 0 :=
  by
  refine' ⟨fun h => _, fun h => _⟩
  · contrapose! h
    obtain ⟨x, hx⟩ := h
    suffices 1 ≤ Module.rank R M by
      intro h
      exact this.not_lt (h.symm ▸ zero_lt_one)
    suffices LinearIndependent R fun y : ({x} : Set M) => ↑y by
      simpa using cardinal_le_dim_of_linearIndependent this
    exact linearIndependent_singleton hx
  · have : (⊤ : Submodule R M) = ⊥ := by
      ext x
      simp [h x]
    rw [← dim_top, this, dim_bot]
#align dim_zero_iff_forall_zero dim_zero_iff_forall_zero

theorem dim_zero_iff : Module.rank R M = 0 ↔ Subsingleton M :=
  dim_zero_iff_forall_zero.trans (subsingleton_iff_forall_eq 0).symm
#align dim_zero_iff dim_zero_iff

theorem dim_pos_iff_exists_ne_zero : 0 < Module.rank R M ↔ ∃ x : M, x ≠ 0 :=
  by
  rw [← not_iff_not]
  simpa using dim_zero_iff_forall_zero
#align dim_pos_iff_exists_ne_zero dim_pos_iff_exists_ne_zero

theorem dim_pos_iff_nontrivial : 0 < Module.rank R M ↔ Nontrivial M :=
  dim_pos_iff_exists_ne_zero.trans (nontrivial_iff_exists_ne 0).symm
#align dim_pos_iff_nontrivial dim_pos_iff_nontrivial

theorem dim_pos [h : Nontrivial M] : 0 < Module.rank R M :=
  dim_pos_iff_nontrivial.2 h
#align dim_pos dim_pos

end rank_zero

section InvariantBasisNumber

variable {R : Type u} [Ring R] [InvariantBasisNumber R]

variable {M : Type v} [AddCommGroup M] [Module R M]

/-- The dimension theorem: if `v` and `v'` are two bases, their index types
have the same cardinalities. -/
theorem mk_eq_mk_of_basis (v : Basis ι R M) (v' : Basis ι' R M) :
    Cardinal.lift.{w'} (#ι) = Cardinal.lift.{w} (#ι') :=
  by
  haveI := nontrivial_of_invariantBasisNumber R
  cases fintypeOrInfinite ι
  · -- `v` is a finite basis, so by `basis_fintype_of_finite_spans` so is `v'`.
    haveI : Fintype (range v) := Set.fintypeRange v
    haveI := basisFintypeOfFiniteSpans _ v.span_eq v'
    -- We clean up a little:
    rw [Cardinal.mk_fintype, Cardinal.mk_fintype]
    simp only [Cardinal.lift_natCast, Cardinal.natCast_inj]
    -- Now we can use invariant basis number to show they have the same cardinality.
    apply card_eq_of_linearEquiv R
    exact
      (Finsupp.linearEquivFunOnFinite R R ι).symm.trans v.repr.symm ≪≫ₗ v'.repr ≪≫ₗ
        Finsupp.linearEquivFunOnFinite R R ι'
  · -- `v` is an infinite basis,
    -- so by `infinite_basis_le_maximal_linear_independent`, `v'` is at least as big,
    -- and then applying `infinite_basis_le_maximal_linear_independent` again
    -- we see they have the same cardinality.
    have w₁ := infinite_basis_le_maximal_linear_independent' v _ v'.linear_independent v'.maximal
    rcases cardinal.lift_mk_le'.mp w₁ with ⟨f⟩
    haveI : Infinite ι' := Infinite.of_injective f f.2
    have w₂ := infinite_basis_le_maximal_linear_independent' v' _ v.linear_independent v.maximal
    exact le_antisymm w₁ w₂
#align mk_eq_mk_of_basis mk_eq_mk_of_basis

/-- Given two bases indexed by `ι` and `ι'` of an `R`-module, where `R` satisfies the invariant
basis number property, an equiv `ι ≃ ι' `. -/
def Basis.indexEquiv (v : Basis ι R M) (v' : Basis ι' R M) : ι ≃ ι' :=
  Nonempty.some (Cardinal.lift_mk_eq.1 (Cardinal.lift_umax_eq.2 (mk_eq_mk_of_basis v v')))
#align basis.index_equiv Basis.indexEquiv

theorem mk_eq_mk_of_basis' {ι' : Type w} (v : Basis ι R M) (v' : Basis ι' R M) : (#ι) = (#ι') :=
  Cardinal.lift_inj.1 <| mk_eq_mk_of_basis v v'
#align mk_eq_mk_of_basis' mk_eq_mk_of_basis'

end InvariantBasisNumber

section RankCondition

variable {R : Type u} [Ring R] [RankCondition R]

variable {M : Type v} [AddCommGroup M] [Module R M]

/-- An auxiliary lemma for `basis.le_span`.

If `R` satisfies the rank condition,
then for any finite basis `b : basis ι R M`,
and any finite spanning set `w : set M`,
the cardinality of `ι` is bounded by the cardinality of `w`.
-/
theorem Basis.le_span'' {ι : Type _} [Fintype ι] (b : Basis ι R M) {w : Set M} [Fintype w]
    (s : span R w = ⊤) : Fintype.card ι ≤ Fintype.card w :=
  by
  -- We construct an surjective linear map `(w → R) →ₗ[R] (ι → R)`,
  -- by expressing a linear combination in `w` as a linear combination in `ι`.
  fapply card_le_of_surjective' R
  · exact b.repr.to_linear_map.comp (Finsupp.total w M R coe)
  · apply surjective.comp
    apply LinearEquiv.surjective
    rw [← LinearMap.range_eq_top, Finsupp.range_total]
    simpa using s
#align basis.le_span'' Basis.le_span''

/--
Another auxiliary lemma for `basis.le_span`, which does not require assuming the basis is finite,
but still assumes we have a finite spanning set.
-/
theorem basis_le_span' {ι : Type _} (b : Basis ι R M) {w : Set M} [Fintype w] (s : span R w = ⊤) :
    (#ι) ≤ Fintype.card w :=
  by
  haveI := nontrivial_of_invariantBasisNumber R
  haveI := basisFintypeOfFiniteSpans w s b
  rw [Cardinal.mk_fintype ι]
  simp only [Cardinal.natCast_le]
  exact Basis.le_span'' b s
#align basis_le_span' basis_le_span'

-- Note that if `R` satisfies the strong rank condition,
-- this also follows from `linear_independent_le_span` below.
/-- If `R` satisfies the rank condition,
then the cardinality of any basis is bounded by the cardinality of any spanning set.
-/
theorem Basis.le_span {J : Set M} (v : Basis ι R M) (hJ : span R J = ⊤) : (#range v) ≤ (#J) :=
  by
  haveI := nontrivial_of_invariantBasisNumber R
  cases fintypeOrInfinite J
  · rw [← Cardinal.lift_le, Cardinal.mk_range_eq_of_injective v.injective, Cardinal.mk_fintype J]
    convert Cardinal.lift_le.{w, v}.2 (basis_le_span' v hJ)
    simp
  · have := Cardinal.mk_range_eq_of_injective v.injective
    let S : J → Set ι := fun j => ↑(v.repr j).support
    let S' : J → Set M := fun j => v '' S j
    have hs : range v ⊆ ⋃ j, S' j := by
      intro b hb
      rcases mem_range.1 hb with ⟨i, hi⟩
      have : span R J ≤ comap v.repr.to_linear_map (Finsupp.supported R R (⋃ j, S j)) :=
        span_le.2 fun j hj x hx => ⟨_, ⟨⟨j, hj⟩, rfl⟩, hx⟩
      rw [hJ] at this
      replace : v.repr (v i) ∈ Finsupp.supported R R (⋃ j, S j) := this trivial
      rw [v.repr_self, Finsupp.mem_supported, Finsupp.support_single_ne_zero _ one_ne_zero] at this
      · subst b
        rcases mem_Union.1 (this (Finset.mem_singleton_self _)) with ⟨j, hj⟩
        exact mem_Union.2 ⟨j, (mem_image _ _ _).2 ⟨i, hj, rfl⟩⟩
      · infer_instance
    refine' le_of_not_lt fun IJ => _
    suffices (#⋃ j, S' j) < (#range v) by exact not_le_of_lt this ⟨Set.embeddingOfSubset _ _ hs⟩
    refine'
      lt_of_le_of_lt (le_trans Cardinal.mk_unionᵢ_le_sum_mk (Cardinal.sum_le_sum _ (fun _ => ℵ₀) _))
        _
    · exact fun j => (Cardinal.lt_aleph0_of_finite _).le
    · simpa
#align basis.le_span Basis.le_span

end RankCondition

section StrongRankCondition

variable {R : Type u} [Ring R] [StrongRankCondition R]

variable {M : Type v} [AddCommGroup M] [Module R M]

open Submodule

-- An auxiliary lemma for `linear_independent_le_span'`,
-- with the additional assumption that the linearly independent family is finite.
theorem linearIndependent_le_span_aux' {ι : Type _} [Fintype ι] (v : ι → M)
    (i : LinearIndependent R v) (w : Set M) [Fintype w] (s : range v ≤ span R w) :
    Fintype.card ι ≤ Fintype.card w :=
  by
  -- We construct an injective linear map `(ι → R) →ₗ[R] (w → R)`,
  -- by thinking of `f : ι → R` as a linear combination of the finite family `v`,
  -- and expressing that (using the axiom of choice) as a linear combination over `w`.
  -- We can do this linearly by constructing the map on a basis.
  fapply card_le_of_injective' R
  · apply Finsupp.total
    exact fun i => Span.repr R w ⟨v i, s (mem_range_self i)⟩
  · intro f g h
    apply_fun Finsupp.total w M R coe  at h
    simp only [Finsupp.total_total, Submodule.coe_mk, Span.finsupp_total_repr] at h
    rw [← sub_eq_zero, ← LinearMap.map_sub] at h
    exact sub_eq_zero.mp (linear_independent_iff.mp i _ h)
#align linear_independent_le_span_aux' linearIndependent_le_span_aux'

/-- If `R` satisfies the strong rank condition,
then any linearly independent family `v : ι → M`
contained in the span of some finite `w : set M`,
is itself finite.
-/
def linearIndependentFintypeOfLeSpanFintype {ι : Type _} (v : ι → M) (i : LinearIndependent R v)
    (w : Set M) [Fintype w] (s : range v ≤ span R w) : Fintype ι :=
  fintypeOfFinsetCardLe (Fintype.card w) fun t =>
    by
    let v' := fun x : (t : Set ι) => v x
    have i' : LinearIndependent R v' := i.comp _ Subtype.val_injective
    have s' : range v' ≤ span R w := (range_comp_subset_range _ _).trans s
    simpa using linearIndependent_le_span_aux' v' i' w s'
#align linear_independent_fintype_of_le_span_fintype linearIndependentFintypeOfLeSpanFintype

/-- If `R` satisfies the strong rank condition,
then for any linearly independent family `v : ι → M`
contained in the span of some finite `w : set M`,
the cardinality of `ι` is bounded by the cardinality of `w`.
-/
theorem linearIndependent_le_span' {ι : Type _} (v : ι → M) (i : LinearIndependent R v) (w : Set M)
    [Fintype w] (s : range v ≤ span R w) : (#ι) ≤ Fintype.card w :=
  by
  haveI : Fintype ι := linearIndependentFintypeOfLeSpanFintype v i w s
  rw [Cardinal.mk_fintype]
  simp only [Cardinal.natCast_le]
  exact linearIndependent_le_span_aux' v i w s
#align linear_independent_le_span' linearIndependent_le_span'

/-- If `R` satisfies the strong rank condition,
then for any linearly independent family `v : ι → M`
and any finite spanning set `w : set M`,
the cardinality of `ι` is bounded by the cardinality of `w`.
-/
theorem linearIndependent_le_span {ι : Type _} (v : ι → M) (i : LinearIndependent R v) (w : Set M)
    [Fintype w] (s : span R w = ⊤) : (#ι) ≤ Fintype.card w :=
  by
  apply linearIndependent_le_span' v i w
  rw [s]
  exact le_top
#align linear_independent_le_span linearIndependent_le_span

/-- An auxiliary lemma for `linear_independent_le_basis`:
we handle the case where the basis `b` is infinite.
-/
theorem linearIndependent_le_infinite_basis {ι : Type _} (b : Basis ι R M) [Infinite ι] {κ : Type _}
    (v : κ → M) (i : LinearIndependent R v) : (#κ) ≤ (#ι) :=
  by
  by_contra
  rw [not_le, ← Cardinal.mk_finset_of_infinite ι] at h
  let Φ := fun k : κ => (b.repr (v k)).support
  obtain ⟨s, w : Infinite ↥(Φ ⁻¹' {s})⟩ := Cardinal.exists_infinite_fiber Φ h (by infer_instance)
  let v' := fun k : Φ ⁻¹' {s} => v k
  have i' : LinearIndependent R v' := i.comp _ Subtype.val_injective
  have w' : Fintype (Φ ⁻¹' {s}) :=
    by
    apply linearIndependentFintypeOfLeSpanFintype v' i' (s.image b)
    rintro m ⟨⟨p, ⟨rfl⟩⟩, rfl⟩
    simp only [SetLike.mem_coe, Subtype.coe_mk, Finset.coe_image]
    apply Basis.mem_span_repr_support
  exact w.false
#align linear_independent_le_infinite_basis linearIndependent_le_infinite_basis

/-- Over any ring `R` satisfying the strong rank condition,
if `b` is a basis for a module `M`,
and `s` is a linearly independent set,
then the cardinality of `s` is bounded by the cardinality of `b`.
-/
theorem linearIndependent_le_basis {ι : Type _} (b : Basis ι R M) {κ : Type _} (v : κ → M)
    (i : LinearIndependent R v) : (#κ) ≤ (#ι) :=
  by
  -- We split into cases depending on whether `ι` is infinite.
    cases fintypeOrInfinite ι <;>
    skip
  · -- When `ι` is finite, we have `linear_independent_le_span`,
    rw [Cardinal.mk_fintype ι]
    haveI : Nontrivial R := nontrivial_of_invariantBasisNumber R
    rw [Fintype.card_congr (Equiv.ofInjective b b.injective)]
    exact linearIndependent_le_span v i (range b) b.span_eq
  ·-- and otherwise we have `linear_indepedent_le_infinite_basis`.
    exact linearIndependent_le_infinite_basis b v i
#align linear_independent_le_basis linearIndependent_le_basis

/-- In an `n`-dimensional space, the rank is at most `m`. -/
theorem Basis.card_le_card_of_linearIndependent_aux {R : Type _} [Ring R] [StrongRankCondition R]
    (n : ℕ) {m : ℕ} (v : Fin m → Fin n → R) : LinearIndependent R v → m ≤ n := fun h => by
  simpa using linearIndependent_le_basis (Pi.basisFun R (Fin n)) v h
#align basis.card_le_card_of_linear_independent_aux Basis.card_le_card_of_linearIndependent_aux

-- When the basis is not infinite this need not be true!
/-- Over any ring `R` satisfying the strong rank condition,
if `b` is an infinite basis for a module `M`,
then every maximal linearly independent set has the same cardinality as `b`.

This proof (along with some of the lemmas above) comes from
[Les familles libres maximales d'un module ont-elles le meme cardinal?][lazarus1973]
-/
theorem maximal_linearIndependent_eq_infinite_basis {ι : Type _} (b : Basis ι R M) [Infinite ι]
    {κ : Type _} (v : κ → M) (i : LinearIndependent R v) (m : i.Maximal) : (#κ) = (#ι) :=
  by
  apply le_antisymm
  · exact linearIndependent_le_basis b v i
  · haveI : Nontrivial R := nontrivial_of_invariantBasisNumber R
    exact infinite_basis_le_maximal_linearIndependent b v i m
#align maximal_linear_independent_eq_infinite_basis maximal_linearIndependent_eq_infinite_basis

theorem Basis.mk_eq_dim'' {ι : Type v} (v : Basis ι R M) : (#ι) = Module.rank R M :=
  by
  haveI := nontrivial_of_invariantBasisNumber R
  rw [Module.rank]
  apply le_antisymm
  · trans
    swap
    apply le_csupᵢ (Cardinal.bddAbove_range.{v, v} _)
    exact
      ⟨Set.range v, by
        convert v.reindex_range.linear_independent
        ext
        simp⟩
    exact (Cardinal.mk_range_eq v v.injective).ge
  · apply csupᵢ_le'
    rintro ⟨s, li⟩
    apply linearIndependent_le_basis v _ li
#align basis.mk_eq_dim'' Basis.mk_eq_dim''

theorem Basis.mk_range_eq_dim (v : Basis ι R M) : (#range v) = Module.rank R M :=
  v.reindexRange.mk_eq_dim''
#align basis.mk_range_eq_dim Basis.mk_range_eq_dim

/-- If a vector space has a finite basis, then its dimension (seen as a cardinal) is equal to the
cardinality of the basis. -/
theorem dim_eq_card_basis {ι : Type w} [Fintype ι] (h : Basis ι R M) :
    Module.rank R M = Fintype.card ι :=
  by
  haveI := nontrivial_of_invariantBasisNumber R
  rw [← h.mk_range_eq_dim, Cardinal.mk_fintype, Set.card_range_of_injective h.injective]
#align dim_eq_card_basis dim_eq_card_basis

theorem Basis.card_le_card_of_linearIndependent {ι : Type _} [Fintype ι] (b : Basis ι R M)
    {ι' : Type _} [Fintype ι'] {v : ι' → M} (hv : LinearIndependent R v) :
    Fintype.card ι' ≤ Fintype.card ι :=
  by
  letI := nontrivial_of_invariantBasisNumber R
  simpa [dim_eq_card_basis b, Cardinal.mk_fintype] using
    cardinal_lift_le_dim_of_linear_independent' hv
#align basis.card_le_card_of_linear_independent Basis.card_le_card_of_linearIndependent

theorem Basis.card_le_card_of_submodule (N : Submodule R M) [Fintype ι] (b : Basis ι R M)
    [Fintype ι'] (b' : Basis ι' R N) : Fintype.card ι' ≤ Fintype.card ι :=
  b.card_le_card_of_linearIndependent (b'.LinearIndependent.map' N.Subtype N.ker_subtype)
#align basis.card_le_card_of_submodule Basis.card_le_card_of_submodule

theorem Basis.card_le_card_of_le {N O : Submodule R M} (hNO : N ≤ O) [Fintype ι] (b : Basis ι R O)
    [Fintype ι'] (b' : Basis ι' R N) : Fintype.card ι' ≤ Fintype.card ι :=
  b.card_le_card_of_linearIndependent
    (b'.LinearIndependent.map' (Submodule.ofLe hNO) (N.ker_ofLe O _))
#align basis.card_le_card_of_le Basis.card_le_card_of_le

theorem Basis.mk_eq_dim (v : Basis ι R M) :
    Cardinal.lift.{v} (#ι) = Cardinal.lift.{w} (Module.rank R M) :=
  by
  haveI := nontrivial_of_invariantBasisNumber R
  rw [← v.mk_range_eq_dim, Cardinal.mk_range_eq_of_injective v.injective]
#align basis.mk_eq_dim Basis.mk_eq_dim

theorem Basis.mk_eq_dim'.{m} (v : Basis ι R M) :
    Cardinal.lift.{max v m} (#ι) = Cardinal.lift.{max w m} (Module.rank R M) := by
  simpa using v.mk_eq_dim
#align basis.mk_eq_dim' Basis.mk_eq_dim'

/-- If a module has a finite dimension, all bases are indexed by a finite type. -/
theorem Basis.nonempty_fintype_index_of_dim_lt_aleph0 {ι : Type _} (b : Basis ι R M)
    (h : Module.rank R M < ℵ₀) : Nonempty (Fintype ι) := by
  rwa [← Cardinal.lift_lt, ←
    b.mk_eq_dim,-- ensure `aleph_0` has the correct universe
    Cardinal.lift_aleph0,
    ← Cardinal.lift_aleph0.{u_1, v}, Cardinal.lift_lt, Cardinal.lt_aleph0_iff_fintype] at h
#align basis.nonempty_fintype_index_of_dim_lt_aleph_0 Basis.nonempty_fintype_index_of_dim_lt_aleph0

/-- If a module has a finite dimension, all bases are indexed by a finite type. -/
noncomputable def Basis.fintypeIndexOfDimLtAleph0 {ι : Type _} (b : Basis ι R M)
    (h : Module.rank R M < ℵ₀) : Fintype ι :=
  Classical.choice (b.nonempty_fintype_index_of_dim_lt_aleph0 h)
#align basis.fintype_index_of_dim_lt_aleph_0 Basis.fintypeIndexOfDimLtAleph0

/-- If a module has a finite dimension, all bases are indexed by a finite set. -/
theorem Basis.finite_index_of_dim_lt_aleph0 {ι : Type _} {s : Set ι} (b : Basis s R M)
    (h : Module.rank R M < ℵ₀) : s.Finite :=
  finite_def.2 (b.nonempty_fintype_index_of_dim_lt_aleph0 h)
#align basis.finite_index_of_dim_lt_aleph_0 Basis.finite_index_of_dim_lt_aleph0

theorem dim_span {v : ι → M} (hv : LinearIndependent R v) :
    Module.rank R ↥(span R (range v)) = (#range v) :=
  by
  haveI := nontrivial_of_invariantBasisNumber R
  rw [← Cardinal.lift_inj, ← (Basis.span hv).mk_eq_dim,
    Cardinal.mk_range_eq_of_injective (@LinearIndependent.injective ι R M v _ _ _ _ hv)]
#align dim_span dim_span

theorem dim_span_set {s : Set M} (hs : LinearIndependent R (fun x => x : s → M)) :
    Module.rank R ↥(span R s) = (#s) :=
  by
  rw [← @set_of_mem_eq _ s, ← Subtype.range_coe_subtype]
  exact dim_span hs
#align dim_span_set dim_span_set

/-- If `N` is a submodule in a free, finitely generated module,
do induction on adjoining a linear independent element to a submodule. -/
def Submodule.inductionOnRank [IsDomain R] [Fintype ι] (b : Basis ι R M)
    (P : Submodule R M → Sort _)
    (ih :
      ∀ N : Submodule R M,
        (∀ N' ≤ N, ∀ x ∈ N, (∀ (c : R), ∀ y ∈ N', c • x + y = (0 : M) → c = 0) → P N') → P N)
    (N : Submodule R M) : P N :=
  Submodule.inductionOnRankAux b P ih (Fintype.card ι) N fun s hs hli => by
    simpa using b.card_le_card_of_linear_independent hli
#align submodule.induction_on_rank Submodule.inductionOnRank

/-- If `S` a finite-dimensional ring extension of `R` which is free as an `R`-module,
then the rank of an ideal `I` of `S` over `R` is the same as the rank of `S`.
-/
theorem Ideal.rank_eq {R S : Type _} [CommRing R] [StrongRankCondition R] [Ring S] [IsDomain S]
    [Algebra R S] {n m : Type _} [Fintype n] [Fintype m] (b : Basis n R S) {I : Ideal S}
    (hI : I ≠ ⊥) (c : Basis m R I) : Fintype.card m = Fintype.card n :=
  by
  obtain ⟨a, ha⟩ := Submodule.nonzero_mem_of_bot_lt (bot_lt_iff_ne_bot.mpr hI)
  have : LinearIndependent R fun i => b i • a :=
    by
    have hb := b.linear_independent
    rw [Fintype.linearIndependent_iff] at hb⊢
    intro g hg
    apply hb g
    simp only [← smul_assoc, ← Finset.sum_smul, smul_eq_zero] at hg
    exact hg.resolve_right ha
  exact
    le_antisymm
      (b.card_le_card_of_linear_independent
        (c.linear_independent.map' (Submodule.subtype I)
          (linear_map.ker_eq_bot.mpr Subtype.coe_injective)))
      (c.card_le_card_of_linear_independent this)
#align ideal.rank_eq Ideal.rank_eq

variable (R)

@[simp]
theorem dim_self : Module.rank R R = 1 := by
  rw [← Cardinal.lift_inj, ← (Basis.singleton PUnit R).mk_eq_dim, Cardinal.mk_pUnit]
#align dim_self dim_self

end StrongRankCondition

section DivisionRing

variable [DivisionRing K] [AddCommGroup V] [Module K V] [AddCommGroup V₁] [Module K V₁]

variable {K V}

/-- If a vector space has a finite dimension, the index set of `basis.of_vector_space` is finite. -/
theorem Basis.finite_ofVectorSpaceIndex_of_dim_lt_aleph0 (h : Module.rank K V < ℵ₀) :
    (Basis.ofVectorSpaceIndex K V).Finite :=
  finite_def.2 <| (Basis.ofVectorSpace K V).nonempty_fintype_index_of_dim_lt_aleph0 h
#align basis.finite_of_vector_space_index_of_dim_lt_aleph_0 Basis.finite_ofVectorSpaceIndex_of_dim_lt_aleph0

variable [AddCommGroup V'] [Module K V']

/-- Two vector spaces are isomorphic if they have the same dimension. -/
theorem nonempty_linearEquiv_of_lift_dim_eq
    (cond : Cardinal.lift.{v'} (Module.rank K V) = Cardinal.lift.{v} (Module.rank K V')) :
    Nonempty (V ≃ₗ[K] V') := by
  let B := Basis.ofVectorSpace K V
  let B' := Basis.ofVectorSpace K V'
  have : Cardinal.lift.{v', v} (#_) = Cardinal.lift.{v, v'} (#_) := by
    rw [B.mk_eq_dim'', cond, B'.mk_eq_dim'']
  exact (Cardinal.lift_mk_eq.{v, v', 0}.1 this).map (B.equiv B')
#align nonempty_linear_equiv_of_lift_dim_eq nonempty_linearEquiv_of_lift_dim_eq

/-- Two vector spaces are isomorphic if they have the same dimension. -/
theorem nonempty_linearEquiv_of_dim_eq (cond : Module.rank K V = Module.rank K V₁) :
    Nonempty (V ≃ₗ[K] V₁) :=
  nonempty_linearEquiv_of_lift_dim_eq <| congr_arg _ cond
#align nonempty_linear_equiv_of_dim_eq nonempty_linearEquiv_of_dim_eq

section

variable (V V' V₁)

/-- Two vector spaces are isomorphic if they have the same dimension. -/
def LinearEquiv.ofLiftDimEq
    (cond : Cardinal.lift.{v'} (Module.rank K V) = Cardinal.lift.{v} (Module.rank K V')) :
    V ≃ₗ[K] V' :=
  Classical.choice (nonempty_linearEquiv_of_lift_dim_eq cond)
#align linear_equiv.of_lift_dim_eq LinearEquiv.ofLiftDimEq

/-- Two vector spaces are isomorphic if they have the same dimension. -/
def LinearEquiv.ofDimEq (cond : Module.rank K V = Module.rank K V₁) : V ≃ₗ[K] V₁ :=
  Classical.choice (nonempty_linearEquiv_of_dim_eq cond)
#align linear_equiv.of_dim_eq LinearEquiv.ofDimEq

end

/-- Two vector spaces are isomorphic if and only if they have the same dimension. -/
theorem LinearEquiv.nonempty_equiv_iff_lift_dim_eq :
    Nonempty (V ≃ₗ[K] V') ↔
      Cardinal.lift.{v'} (Module.rank K V) = Cardinal.lift.{v} (Module.rank K V') :=
  ⟨fun ⟨h⟩ => LinearEquiv.lift_dim_eq h, fun h => nonempty_linearEquiv_of_lift_dim_eq h⟩
#align linear_equiv.nonempty_equiv_iff_lift_dim_eq LinearEquiv.nonempty_equiv_iff_lift_dim_eq

/-- Two vector spaces are isomorphic if and only if they have the same dimension. -/
theorem LinearEquiv.nonempty_equiv_iff_dim_eq :
    Nonempty (V ≃ₗ[K] V₁) ↔ Module.rank K V = Module.rank K V₁ :=
  ⟨fun ⟨h⟩ => LinearEquiv.dim_eq h, fun h => nonempty_linearEquiv_of_dim_eq h⟩
#align linear_equiv.nonempty_equiv_iff_dim_eq LinearEquiv.nonempty_equiv_iff_dim_eq

-- TODO how far can we generalise this?
-- When `s` is finite, we could prove this for any ring satisfying the strong rank condition
-- using `linear_independent_le_span'`
theorem dim_span_le (s : Set V) : Module.rank K (span K s) ≤ (#s) :=
  by
  obtain ⟨b, hb, hsab, hlib⟩ := exists_linearIndependent K s
  convert Cardinal.mk_le_mk_of_subset hb
  rw [← hsab, dim_span_set hlib]
#align dim_span_le dim_span_le

theorem dim_span_of_finset (s : Finset V) : Module.rank K (span K (↑s : Set V)) < ℵ₀ :=
  calc
    Module.rank K (span K (↑s : Set V)) ≤ (#(↑s : Set V)) := dim_span_le ↑s
    _ = s.card := by rw [Finset.coe_sort_coe, Cardinal.mk_coe_finset]
    _ < ℵ₀ := Cardinal.nat_lt_aleph0 _

#align dim_span_of_finset dim_span_of_finset

theorem dim_prod : Module.rank K (V × V₁) = Module.rank K V + Module.rank K V₁ :=
  by
  let b := Basis.ofVectorSpace K V
  let c := Basis.ofVectorSpace K V₁
  rw [← Cardinal.lift_inj, ← (Basis.prod b c).mk_eq_dim, Cardinal.lift_add, ← Cardinal.mk_uLift, ←
    b.mk_eq_dim, ← c.mk_eq_dim, ← Cardinal.mk_uLift, ← Cardinal.mk_uLift,
    Cardinal.add_def (ULift _)]
  exact
    Cardinal.lift_inj.1
      (Cardinal.lift_mk_eq.2 ⟨equiv.ulift.trans (Equiv.sumCongr Equiv.ulift Equiv.ulift).symm⟩)
#align dim_prod dim_prod

section Fintype

variable [∀ i, AddCommGroup (φ i)] [∀ i, Module K (φ i)]

open LinearMap

theorem dim_pi [Finite η] : Module.rank K (∀ i, φ i) = Cardinal.sum fun i => Module.rank K (φ i) :=
  by
  cases nonempty_fintype η
  let b i := Basis.ofVectorSpace K (φ i)
  let this : Basis (Σj, _) K (∀ j, φ j) := Pi.basis b
  rw [← Cardinal.lift_inj, ← this.mk_eq_dim]
  simp [← (b _).mk_range_eq_dim]
#align dim_pi dim_pi

variable [Fintype η]

theorem dim_fun {V η : Type u} [Fintype η] [AddCommGroup V] [Module K V] :
    Module.rank K (η → V) = Fintype.card η * Module.rank K V := by
  rw [dim_pi, Cardinal.sum_const', Cardinal.mk_fintype]
#align dim_fun dim_fun

theorem dim_fun_eq_lift_mul :
    Module.rank K (η → V) =
      (Fintype.card η : Cardinal.{max u₁' v}) * Cardinal.lift.{u₁'} (Module.rank K V) :=
  by rw [dim_pi, Cardinal.sum_const, Cardinal.mk_fintype, Cardinal.lift_natCast]
#align dim_fun_eq_lift_mul dim_fun_eq_lift_mul

theorem dim_fun' : Module.rank K (η → K) = Fintype.card η := by
  rw [dim_fun_eq_lift_mul, dim_self, Cardinal.lift_one, mul_one, Cardinal.natCast_inj]
#align dim_fun' dim_fun'

theorem dim_fin_fun (n : ℕ) : Module.rank K (Fin n → K) = n := by simp [dim_fun']
#align dim_fin_fun dim_fin_fun

end Fintype

theorem dim_quotient_add_dim (p : Submodule K V) :
    Module.rank K (V ⧸ p) + Module.rank K p = Module.rank K V := by
  classical exact
      let ⟨f⟩ := quotient_prod_linearEquiv p
      dim_prod.symm.trans f.dim_eq
#align dim_quotient_add_dim dim_quotient_add_dim

/-- rank-nullity theorem -/
theorem dim_range_add_dim_ker (f : V →ₗ[K] V₁) :
    Module.rank K f.range + Module.rank K f.ker = Module.rank K V :=
  by
  haveI := fun p : Submodule K V => Classical.decEq (V ⧸ p)
  rw [← f.quot_ker_equiv_range.dim_eq, dim_quotient_add_dim]
#align dim_range_add_dim_ker dim_range_add_dim_ker

theorem dim_eq_of_surjective (f : V →ₗ[K] V₁) (h : Surjective f) :
    Module.rank K V = Module.rank K V₁ + Module.rank K f.ker := by
  rw [← dim_range_add_dim_ker f, ← dim_range_of_surjective f h]
#align dim_eq_of_surjective dim_eq_of_surjective

section

variable [AddCommGroup V₂] [Module K V₂]

variable [AddCommGroup V₃] [Module K V₃]

open LinearMap

/-- This is mostly an auxiliary lemma for `dim_sup_add_dim_inf_eq`. -/
theorem dim_add_dim_split (db : V₂ →ₗ[K] V) (eb : V₃ →ₗ[K] V) (cd : V₁ →ₗ[K] V₂) (ce : V₁ →ₗ[K] V₃)
    (hde : ⊤ ≤ db.range ⊔ eb.range) (hgd : ker cd = ⊥) (eq : db.comp cd = eb.comp ce)
    (eq₂ : ∀ d e, db d = eb e → ∃ c, cd c = d ∧ ce c = e) :
    Module.rank K V + Module.rank K V₁ = Module.rank K V₂ + Module.rank K V₃ :=
  by
  have hf : Surjective (coprod db eb) := by rwa [← range_eq_top, range_coprod, eq_top_iff]
  conv =>
    rhs
    rw [← dim_prod, dim_eq_of_surjective _ hf]
  congr 1
  apply LinearEquiv.dim_eq
  refine' LinearEquiv.ofBijective _ ⟨_, _⟩
  · refine' cod_restrict _ (Prod cd (-ce)) _
    · intro c
      simp only [add_eq_zero_iff_eq_neg, LinearMap.prod_apply, mem_ker, Pi.prod, coprod_apply,
        neg_neg, map_neg, neg_apply]
      exact LinearMap.ext_iff.1 Eq c
  · rw [← ker_eq_bot, ker_cod_restrict, ker_prod, hgd, bot_inf_eq]
  · rw [← range_eq_top, eq_top_iff, range_cod_restrict, ← map_le_iff_le_comap, Submodule.map_top,
      range_subtype]
    rintro ⟨d, e⟩
    have h := eq₂ d (-e)
    simp only [add_eq_zero_iff_eq_neg, LinearMap.prod_apply, mem_ker, SetLike.mem_coe,
      Prod.mk.inj_iff, coprod_apply, map_neg, neg_apply, LinearMap.mem_range, Pi.prod] at h⊢
    intro hde
    rcases h hde with ⟨c, h₁, h₂⟩
    refine' ⟨c, h₁, _⟩
    rw [h₂, _root_.neg_neg]
#align dim_add_dim_split dim_add_dim_split

theorem dim_sup_add_dim_inf_eq (s t : Submodule K V) :
    Module.rank K (s ⊔ t : Submodule K V) + Module.rank K (s ⊓ t : Submodule K V) =
      Module.rank K s + Module.rank K t :=
  dim_add_dim_split (ofLe le_sup_left) (ofLe le_sup_right) (ofLe inf_le_left) (ofLe inf_le_right)
    (by
      rw [← map_le_map_iff' (ker_subtype <| s ⊔ t), Submodule.map_sup, Submodule.map_top, ←
        LinearMap.range_comp, ← LinearMap.range_comp, subtype_comp_of_le, subtype_comp_of_le,
        range_subtype, range_subtype, range_subtype]
      exact le_rfl)
    (ker_ofLe _ _ _) (by ext ⟨x, hx⟩; rfl)
    (by
      rintro ⟨b₁, hb₁⟩ ⟨b₂, hb₂⟩ eq
      obtain rfl : b₁ = b₂ := congr_arg Subtype.val Eq
      exact ⟨⟨b₁, hb₁, hb₂⟩, rfl, rfl⟩)
#align dim_sup_add_dim_inf_eq dim_sup_add_dim_inf_eq

theorem dim_add_le_dim_add_dim (s t : Submodule K V) :
    Module.rank K (s ⊔ t : Submodule K V) ≤ Module.rank K s + Module.rank K t :=
  by
  rw [← dim_sup_add_dim_inf_eq]
  exact self_le_add_right _ _
#align dim_add_le_dim_add_dim dim_add_le_dim_add_dim

end

theorem exists_mem_ne_zero_of_dim_pos {s : Submodule K V} (h : 0 < Module.rank K s) :
    ∃ b : V, b ∈ s ∧ b ≠ 0 :=
  exists_mem_ne_zero_of_ne_bot fun eq => by rw [Eq, dim_bot] at h <;> exact lt_irrefl _ h
#align exists_mem_ne_zero_of_dim_pos exists_mem_ne_zero_of_dim_pos

end DivisionRing

section rank

section

variable [Ring K] [AddCommGroup V] [Module K V] [AddCommGroup V₁] [Module K V₁]

variable [AddCommGroup V'] [Module K V']

/-- `rank f` is the rank of a `linear_map f`, defined as the dimension of `f.range`. -/
def rank (f : V →ₗ[K] V') : Cardinal :=
  Module.rank K f.range
#align rank rank

theorem rank_le_range (f : V →ₗ[K] V₁) : rank f ≤ Module.rank K V₁ :=
  dim_submodule_le _
#align rank_le_range rank_le_range

@[simp]
theorem rank_zero [Nontrivial K] : rank (0 : V →ₗ[K] V') = 0 := by
  rw [rank, LinearMap.range_zero, dim_bot]
#align rank_zero rank_zero

variable [AddCommGroup V''] [Module K V'']

theorem rank_comp_le1 (g : V →ₗ[K] V') (f : V' →ₗ[K] V'') : rank (f.comp g) ≤ rank f :=
  by
  refine' dim_le_of_submodule _ _ _
  rw [LinearMap.range_comp]
  exact LinearMap.map_le_range
#align rank_comp_le1 rank_comp_le1

variable [AddCommGroup V'₁] [Module K V'₁]

theorem rank_comp_le2 (g : V →ₗ[K] V') (f : V' →ₗ[K] V'₁) : rank (f.comp g) ≤ rank g := by
  rw [rank, rank, LinearMap.range_comp] <;> exact dim_map_le _ _
#align rank_comp_le2 rank_comp_le2

end

end rank

section DivisionRing

variable [DivisionRing K] [AddCommGroup V] [Module K V] [AddCommGroup V₁] [Module K V₁]

variable [AddCommGroup V'] [Module K V']

theorem rank_le_domain (f : V →ₗ[K] V₁) : rank f ≤ Module.rank K V :=
  by
  rw [← dim_range_add_dim_ker f]
  exact self_le_add_right _ _
#align rank_le_domain rank_le_domain

theorem rank_add_le (f g : V →ₗ[K] V') : rank (f + g) ≤ rank f + rank g :=
  calc
    rank (f + g) ≤ Module.rank K (f.range ⊔ g.range : Submodule K V') :=
      by
      refine' dim_le_of_submodule _ _ _
      exact
        LinearMap.range_le_iff_comap.2 <|
          eq_top_iff'.2 fun x =>
            show f x + g x ∈ (f.range ⊔ g.range : Submodule K V') from
              mem_sup.2 ⟨_, ⟨x, rfl⟩, _, ⟨x, rfl⟩, rfl⟩
    _ ≤ rank f + rank g := dim_add_le_dim_add_dim _ _

#align rank_add_le rank_add_le

theorem rank_finset_sum_le {η} (s : Finset η) (f : η → V →ₗ[K] V') :
    rank (∑ d in s, f d) ≤ ∑ d in s, rank (f d) :=
  @Finset.sum_hom_rel _ _ _ _ _ (fun a b => rank a ≤ b) f (fun d => rank (f d)) s
    (le_of_eq rank_zero) fun i g c h => le_trans (rank_add_le _ _) (add_le_add_left h _)
#align rank_finset_sum_le rank_finset_sum_le

/-- The `ι` indexed basis on `V`, where `ι` is an empty type and `V` is zero-dimensional.

See also `finite_dimensional.fin_basis`.
-/
def Basis.ofDimEqZero {ι : Type _} [IsEmpty ι] (hV : Module.rank K V = 0) : Basis ι K V :=
  haveI : Subsingleton V := dim_zero_iff.1 hV
  Basis.empty _
#align basis.of_dim_eq_zero Basis.ofDimEqZero

@[simp]
theorem Basis.ofDimEqZero_apply {ι : Type _} [IsEmpty ι] (hV : Module.rank K V = 0) (i : ι) :
    Basis.ofDimEqZero hV i = 0 :=
  rfl
#align basis.of_dim_eq_zero_apply Basis.ofDimEqZero_apply

theorem le_dim_iff_exists_linearIndependent {c : Cardinal} :
    c ≤ Module.rank K V ↔ ∃ s : Set V, (#s) = c ∧ LinearIndependent K (coe : s → V) :=
  by
  constructor
  · intro h
    let t := Basis.ofVectorSpace K V
    rw [← t.mk_eq_dim'', Cardinal.le_mk_iff_exists_subset] at h
    rcases h with ⟨s, hst, hsc⟩
    exact ⟨s, hsc, (of_vector_space_index.linear_independent K V).mono hst⟩
  · rintro ⟨s, rfl, si⟩
    exact cardinal_le_dim_of_linearIndependent si
#align le_dim_iff_exists_linear_independent le_dim_iff_exists_linearIndependent

theorem le_dim_iff_exists_linearIndependent_finset {n : ℕ} :
    ↑n ≤ Module.rank K V ↔
      ∃ s : Finset V, s.card = n ∧ LinearIndependent K (coe : (s : Set V) → V) :=
  by
  simp only [le_dim_iff_exists_linearIndependent, Cardinal.mk_set_eq_nat_iff_finset]
  constructor
  · rintro ⟨s, ⟨t, rfl, rfl⟩, si⟩
    exact ⟨t, rfl, si⟩
  · rintro ⟨s, rfl, si⟩
    exact ⟨s, ⟨s, rfl, rfl⟩, si⟩
#align le_dim_iff_exists_linear_independent_finset le_dim_iff_exists_linearIndependent_finset

/-- A vector space has dimension at most `1` if and only if there is a
single vector of which all vectors are multiples. -/
theorem dim_le_one_iff : Module.rank K V ≤ 1 ↔ ∃ v₀ : V, ∀ v, ∃ r : K, r • v₀ = v :=
  by
  let b := Basis.ofVectorSpace K V
  constructor
  · intro hd
    rw [← b.mk_eq_dim'', Cardinal.le_one_iff_subsingleton, subsingleton_coe] at hd
    rcases eq_empty_or_nonempty (of_vector_space_index K V) with (hb | ⟨⟨v₀, hv₀⟩⟩)
    · use 0
      have h' : ∀ v : V, v = 0 := by simpa [hb, Submodule.eq_bot_iff] using b.span_eq.symm
      intro v
      simp [h' v]
    · use v₀
      have h' : (K ∙ v₀) = ⊤ := by simpa [hd.eq_singleton_of_mem hv₀] using b.span_eq
      intro v
      have hv : v ∈ (⊤ : Submodule K V) := mem_top
      rwa [← h', mem_span_singleton] at hv
  · rintro ⟨v₀, hv₀⟩
    have h : (K ∙ v₀) = ⊤ := by
      ext
      simp [mem_span_singleton, hv₀]
    rw [← dim_top, ← h]
    convert dim_span_le _
    simp
#align dim_le_one_iff dim_le_one_iff

/-- A submodule has dimension at most `1` if and only if there is a
single vector in the submodule such that the submodule is contained in
its span. -/
theorem dim_submodule_le_one_iff (s : Submodule K V) : Module.rank K s ≤ 1 ↔ ∃ v₀ ∈ s, s ≤ K ∙ v₀ :=
  by
  simp_rw [dim_le_one_iff, le_span_singleton_iff]
  constructor
  · rintro ⟨⟨v₀, hv₀⟩, h⟩
    use v₀, hv₀
    intro v hv
    obtain ⟨r, hr⟩ := h ⟨v, hv⟩
    use r
    simp_rw [Subtype.ext_iff, coe_smul, Submodule.coe_mk] at hr
    exact hr
  · rintro ⟨v₀, hv₀, h⟩
    use ⟨v₀, hv₀⟩
    rintro ⟨v, hv⟩
    obtain ⟨r, hr⟩ := h v hv
    use r
    simp_rw [Subtype.ext_iff, coe_smul, Submodule.coe_mk]
    exact hr
#align dim_submodule_le_one_iff dim_submodule_le_one_iff

/-- A submodule has dimension at most `1` if and only if there is a
single vector, not necessarily in the submodule, such that the
submodule is contained in its span. -/
theorem dim_submodule_le_one_iff' (s : Submodule K V) : Module.rank K s ≤ 1 ↔ ∃ v₀, s ≤ K ∙ v₀ :=
  by
  rw [dim_submodule_le_one_iff]
  constructor
  · rintro ⟨v₀, hv₀, h⟩
    exact ⟨v₀, h⟩
  · rintro ⟨v₀, h⟩
    by_cases hw : ∃ w : V, w ∈ s ∧ w ≠ 0
    · rcases hw with ⟨w, hw, hw0⟩
      use w, hw
      rcases mem_span_singleton.1 (h hw) with ⟨r', rfl⟩
      have h0 : r' ≠ 0 := by
        rintro rfl
        simpa using hw0
      rwa [span_singleton_smul_eq (IsUnit.mk0 _ h0) _]
    · push_neg  at hw
      rw [← Submodule.eq_bot_iff] at hw
      simp [hw]
#align dim_submodule_le_one_iff' dim_submodule_le_one_iff'

theorem Submodule.rank_le_one_iff_isPrincipal (W : Submodule K V) :
    Module.rank K W ≤ 1 ↔ W.IsPrincipal :=
  by
  simp only [dim_le_one_iff, Submodule.isPrincipal_iff, le_antisymm_iff, le_span_singleton_iff,
    span_singleton_le_iff_mem]
  constructor
  · rintro ⟨⟨m, hm⟩, hm'⟩
    choose f hf using hm'
    exact ⟨m, ⟨fun v hv => ⟨f ⟨v, hv⟩, congr_arg coe (hf ⟨v, hv⟩)⟩, hm⟩⟩
  · rintro ⟨a, ⟨h, ha⟩⟩
    choose f hf using h
    exact ⟨⟨a, ha⟩, fun v => ⟨f v.1 v.2, Subtype.ext (hf v.1 v.2)⟩⟩
#align submodule.rank_le_one_iff_is_principal Submodule.rank_le_one_iff_isPrincipal

theorem Module.rank_le_one_iff_top_isPrincipal :
    Module.rank K V ≤ 1 ↔ (⊤ : Submodule K V).IsPrincipal := by
  rw [← Submodule.rank_le_one_iff_isPrincipal, dim_top]
#align module.rank_le_one_iff_top_is_principal Module.rank_le_one_iff_top_isPrincipal

theorem le_rank_iff_exists_linearIndependent {c : Cardinal} {f : V →ₗ[K] V'} :
    c ≤ rank f ↔
      ∃ s : Set V,
        Cardinal.lift.{v'} (#s) = Cardinal.lift.{v} c ∧ LinearIndependent K fun x : s => f x :=
  by
  rcases f.range_restrict.exists_right_inverse_of_surjective f.range_range_restrict with ⟨g, hg⟩
  have fg : left_inverse f.range_restrict g := LinearMap.congr_fun hg
  refine' ⟨fun h => _, _⟩
  · rcases le_dim_iff_exists_linearIndependent.1 h with ⟨s, rfl, si⟩
    refine' ⟨g '' s, Cardinal.mk_image_eq_lift _ _ fg.injective, _⟩
    replace fg : ∀ x, f (g x) = x
    · intro x
      convert congr_arg Subtype.val (fg x)
    replace si : LinearIndependent K fun x : s => f (g x)
    · simpa only [fg] using si.map' _ (ker_subtype _)
    exact si.image_of_comp s g f
  · rintro ⟨s, hsc, si⟩
    have : LinearIndependent K fun x : s => f.range_restrict x :=
      LinearIndependent.of_comp f.range.subtype (by convert si)
    convert cardinal_le_dim_of_linearIndependent this.image
    rw [← Cardinal.lift_inj, ← hsc, Cardinal.mk_image_eq_of_injOn_lift]
    exact inj_on_iff_injective.2 this.injective
#align le_rank_iff_exists_linear_independent le_rank_iff_exists_linearIndependent

theorem le_rank_iff_exists_linearIndependent_finset {n : ℕ} {f : V →ₗ[K] V'} :
    ↑n ≤ rank f ↔ ∃ s : Finset V, s.card = n ∧ LinearIndependent K fun x : (s : Set V) => f x :=
  by
  simp only [le_rank_iff_exists_linearIndependent, Cardinal.lift_natCast, Cardinal.lift_eq_nat_iff,
    Cardinal.mk_set_eq_nat_iff_finset]
  constructor
  · rintro ⟨s, ⟨t, rfl, rfl⟩, si⟩
    exact ⟨t, rfl, si⟩
  · rintro ⟨s, rfl, si⟩
    exact ⟨s, ⟨s, rfl, rfl⟩, si⟩
#align le_rank_iff_exists_linear_independent_finset le_rank_iff_exists_linearIndependent_finset

end DivisionRing

end Module


class Preorder (α : Type u) extends LE α where
  le_refl  (a : α) : a ≤ a
  le_trans {a b c : α} : a ≤ b → b ≤ c → a ≤ c

instance {α : Type u} {β : α → Type v} [(a : α) → Preorder (β a)] : Preorder ((a : α) → β a) where
  le f g := ∀ a, f a ≤ g a
  le_refl f  := fun a => Preorder.le_refl (f a)
  le_trans   := fun h₁ h₂ a => Preorder.le_trans (h₁ a) (h₂ a)

-- In Lean 3, we defined `monotone` using the strict implicit notation `{{ ... }}`.
-- Implicit lambdas in Lean 4 allow us to use the regular `{...}`
def Monotone [Preorder α] [Preorder β] (f : α → β) :=
  ∀ {a b}, a ≤ b → f a ≤ f b

theorem monotone_id [Preorder α] : Monotone (α := α) id :=
  fun h => h

theorem monotone_id' [Preorder α] : Monotone (α := α) id :=
  @fun a b h => h -- `@` disables implicit lambdas

theorem monotone_id'' [Preorder α] : Monotone (α := α) id :=
  fun {a b} (h : a ≤ b) => h -- `{a b}` disables implicit lambdas

theorem monotone_const [Preorder α] [Preorder β] (b : β) : Monotone (fun a : α => b) :=
  fun _ => Preorder.le_refl b

theorem monotone_comp [Preorder α] [Preorder β] [Preorder γ] {g : β → γ} {f : α → β} (m_g : Monotone g) (m_f : Monotone f) : Monotone (g ∘ f) :=
  fun h => m_g (m_f h)

theorem monotone_fun {α : Type u} {β : Type v} [Preorder α] [Preorder γ] {f : α → β → γ} (m : (b : β) → Monotone (fun a => f a b)) : Monotone f :=
  fun h b => m b h

theorem ex [Preorder α] {f g h : α → α} (m_h : Monotone h) (m_g : Monotone g) (m_f : Monotone f) : Monotone (h ∘ g ∘ f) :=
  monotone_comp m_h (monotone_comp m_g m_f) -- implicit lambdas in action here


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

! This file was ported from Lean 3 source module algebra.algebra.restrict_scalars
! leanprover-community/mathlib commit c310cfdc40da4d99a10a58c33a95360ef9e6e0bf
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Algebra.Tower

/-!

# The `RestrictScalars` type alias

See the documentation attached to the `RestrictScalars` definition for advice on how and when to
use this type alias. As described there, it is often a better choice to use the `IsScalarTower`
typeclass instead.

## Main definitions

* `RestrictScalars R S M`: the `S`-module `M` viewed as an `R` module when `S` is an `R`-algebra.
  Note that by default we do *not* have a `Module S (RestrictScalars R S M)` instance
  for the original action.
  This is available as a def `RestrictScalars.moduleOrig` if really needed.
* `RestrictScalars.addEquiv : RestrictScalars R S M ≃+ M`: the additive equivalence
  between the restricted and original space (in fact, they are definitionally equal,
  but sometimes it is helpful to avoid using this fact, to keep instances from leaking).
* `RestrictScalars.ringEquiv : RestrictScalars R S A ≃+* A`: the ring equivalence
   between the restricted and original space when the module is an algebra.

## See also

There are many similarly-named definitions elsewhere which do not refer to this type alias. These
refer to restricting the scalar type in a bundled type, such as from `A →ₗ[R] B` to `A →ₗ[S] B`:

* `LinearMap.RestrictScalars`
* `LinearEquiv.RestrictScalars`
* `AlgHom.RestrictScalars`
* `AlgEquiv.RestrictScalars`
* `Submodule.RestrictScalars`
* `Subalgebra.RestrictScalars`
-/

variable (R S M A : Type _)

/-- If we put an `R`-algebra structure on a semiring `S`, we get a natural equivalence from the
category of `S`-modules to the category of representations of the algebra `S` (over `R`). The type
synonym `RestrictScalars` is essentially this equivalence.

Warning: use this type synonym judiciously! Consider an example where we want to construct an
`R`-linear map from `M` to `S`, given:
```lean
variable (R S M : Type _)
variable [CommSemiring R] [Semiring S] [Algebra R S] [AddCommMonoid M] [Module S M]
```
With the assumptions above we can't directly state our map as we have no `Module R M` structure, but
`RestrictScalars` permits it to be written as:
```lean
-- an `R`-module structure on `M` is provided by `RestrictScalars` which is compatible
example : RestrictScalars R S M →ₗ[R] S := sorry
```
However, it is usually better just to add this extra structure as an argument:
```lean
-- an `R`-module structure on `M` and proof of its compatibility is provided by the user
example [Module R M] [IsScalarTower R S M] : M →ₗ[R] S := sorry
```
The advantage of the second approach is that it defers the duty of providing the missing typeclasses
`[Module R M] [IsScalarTower R S M]`. If some concrete `M` naturally carries these (as is often
the case) then we have avoided `RestrictScalars` entirely. If not, we can pass
`RestrictScalars R S M` later on instead of `M`.

Note that this means we almost always want to state definitions and lemmas in the language of
`IsScalarTower` rather than `RestrictScalars`.

An example of when one might want to use `RestrictScalars` would be if one has a vector space
over a field of characteristic zero and wishes to make use of the `ℚ`-algebra structure. -/
@[nolint unusedArguments]
def RestrictScalars (_R _S M : Type _) : Type _ := M
#align restrict_scalars RestrictScalars

instance [I : Inhabited M] : Inhabited (RestrictScalars R S M) := I

instance [I : AddCommMonoid M] : AddCommMonoid (RestrictScalars R S M) := I

instance [I : AddCommGroup M] : AddCommGroup (RestrictScalars R S M) := I

section Module

section

variable [Semiring S] [AddCommMonoid M]

/-- We temporarily install an action of the original ring on `RestrictScalars R S M`. -/
def RestrictScalars.moduleOrig [I : Module S M] : Module S (RestrictScalars R S M) := I
#align restrict_scalars.module_orig RestrictScalars.moduleOrig

variable [CommSemiring R] [Algebra R S]

section

attribute [local instance] RestrictScalars.moduleOrig

/-- When `M` is a module over a ring `S`, and `S` is an algebra over `R`, then `M` inherits a
module structure over `R`.

The preferred way of setting this up is `[Module R M] [Module S M] [IsScalarTower R S M]`.
-/
instance [Module S M] : Module R (RestrictScalars R S M) :=
  Module.compHom M (algebraMap R S)

/-- This instance is only relevant when `RestrictScalars.moduleOrig` is available as an instance.
-/
instance RestrictScalars.isScalarTower [Module S M] : IsScalarTower R S (RestrictScalars R S M) :=
  ⟨fun r S M ↦ by
    rw [Algebra.smul_def, mul_smul]
    rfl⟩
#align restrict_scalars.is_scalar_tower RestrictScalars.isScalarTower

end

/-- When `M` is a right-module over a ring `S`, and `S` is an algebra over `R`, then `M` inherits a
right-module structure over `R`.
The preferred way of setting this up is
`[Module Rᵐᵒᵖ M] [Module Sᵐᵒᵖ M] [IsScalarTower Rᵐᵒᵖ Sᵐᵒᵖ M]`.
-/
instance RestrictScalars.opModule [Module Sᵐᵒᵖ M] : Module Rᵐᵒᵖ (RestrictScalars R S M) :=
  letI : Module Sᵐᵒᵖ (RestrictScalars R S M) := ‹Module Sᵐᵒᵖ M›
  Module.compHom M (RingHom.op $ algebraMap R S)
#align restrict_scalars.op_module RestrictScalars.opModule

instance RestrictScalars.isCentralScalar [Module S M] [Module Sᵐᵒᵖ M] [IsCentralScalar S M] :
    IsCentralScalar R (RestrictScalars R S M) where
  op_smul_eq_smul r _x := (op_smul_eq_smul (algebraMap R S r) (_ : M) : _)
#align restrict_scalars.is_central_scalar RestrictScalars.isCentralScalar

/-- The `R`-algebra homomorphism from the original coefficient algebra `S` to endomorphisms
of `RestrictScalars R S M`.
-/
def RestrictScalars.lsmul [Module S M] : S →ₐ[R] Module.End R (RestrictScalars R S M) :=
  letI-- We use `RestrictScalars.moduleOrig` in the implementation,
  -- but not in the type.
   : Module S (RestrictScalars R S M) := RestrictScalars.moduleOrig R S M
  Algebra.lsmul R (RestrictScalars R S M)
#align restrict_scalars.lsmul RestrictScalars.lsmul

end

variable [AddCommMonoid M]

/-- `RestrictScalars.addEquiv` is the additive equivalence with the original module. -/
def RestrictScalars.addEquiv : RestrictScalars R S M ≃+ M :=
  AddEquiv.refl M
#align restrict_scalars.add_equiv RestrictScalars.addEquiv

variable [CommSemiring R] [Semiring S] [Algebra R S] [Module S M]

theorem RestrictScalars.smul_def (c : R) (x : RestrictScalars R S M) :
    c • x = (RestrictScalars.addEquiv R S M).symm
      (algebraMap R S c • RestrictScalars.addEquiv R S M x) :=
  rfl
#align restrict_scalars.smul_def RestrictScalars.smul_def

@[simp]
theorem RestrictScalars.addEquiv_map_smul (c : R) (x : RestrictScalars R S M) :
    RestrictScalars.addEquiv R S M (c • x) = algebraMap R S c • RestrictScalars.addEquiv R S M x :=
  rfl
#align restrict_scalars.add_equiv_map_smul RestrictScalars.addEquiv_map_smul

theorem RestrictScalars.addEquiv_symm_map_algebraMap_smul (r : R) (x : M) :
    (RestrictScalars.addEquiv R S M).symm (algebraMap R S r • x) =
      r • (RestrictScalars.addEquiv R S M).symm x :=
  rfl
#align restrict_scalars.add_equiv_symm_map_algebra_map_smul RestrictScalars.addEquiv_symm_map_algebraMap_smul

theorem RestrictScalars.addEquiv_symm_map_smul_smul (r : R) (s : S) (x : M) :
    (RestrictScalars.addEquiv R S M).symm ((r • s) • x) =
      r • (RestrictScalars.addEquiv R S M).symm (s • x) := by
  rw [Algebra.smul_def, mul_smul]
  rfl
#align restrict_scalars.add_equiv_symm_map_smul_smul RestrictScalars.addEquiv_symm_map_smul_smul

theorem RestrictScalars.lsmul_apply_apply (s : S) (x : RestrictScalars R S M) :
    RestrictScalars.lsmul R S M s x =
      (RestrictScalars.addEquiv R S M).symm (s • RestrictScalars.addEquiv R S M x) :=
  rfl
#align restrict_scalars.lsmul_apply_apply RestrictScalars.lsmul_apply_apply

end Module

section Algebra

instance [I : Semiring A] : Semiring (RestrictScalars R S A) := I

instance [I : Ring A] : Ring (RestrictScalars R S A) := I

instance [I : CommSemiring A] : CommSemiring (RestrictScalars R S A) := I

instance [I : CommRing A] : CommRing (RestrictScalars R S A) := I

variable [Semiring A]

/-- Tautological ring isomorphism `RestrictScalars R S A ≃+* A`. -/
def RestrictScalars.ringEquiv : RestrictScalars R S A ≃+* A :=
  RingEquiv.refl _
#align restrict_scalars.ring_equiv RestrictScalars.ringEquiv

variable [CommSemiring S] [Algebra S A] [CommSemiring R] [Algebra R S]

@[simp]
theorem RestrictScalars.ringEquiv_map_smul (r : R) (x : RestrictScalars R S A) :
    RestrictScalars.ringEquiv R S A (r • x) =
      algebraMap R S r • RestrictScalars.ringEquiv R S A x :=
  rfl
#align restrict_scalars.ring_equiv_map_smul RestrictScalars.ringEquiv_map_smul

/-- `R ⟶ S` induces `S-Alg ⥤ R-Alg` -/
instance : Algebra R (RestrictScalars R S A) :=
  { (algebraMap S A).comp (algebraMap R S) with
    smul := (· • ·)
    commutes' := fun _ _ ↦ Algebra.commutes' _ _
    smul_def' := fun _ _ ↦ Algebra.smul_def' _ _ }

@[simp]
theorem RestrictScalars.ringEquiv_algebraMap (r : R) :
    RestrictScalars.ringEquiv R S A (algebraMap R (RestrictScalars R S A) r) =
      algebraMap S A (algebraMap R S r) :=
  rfl
#align restrict_scalars.ring_equiv_algebra_map RestrictScalars.ringEquiv_algebraMap

end Algebra


import system.io data.list.set

meta constant io.mkdir (s : string) [io.interface] : io nat

class has_smul (α β : Type) := (smul : α → β → β)
def smul {α β : Type} [has_smul α β] : α → β → β := has_smul.smul
infixl ` ⬝ ` := smul

namespace prod
section lt
universes u v
variables {A : Type u} [A_deceq : decidable_eq A] [A_lt : has_lt A] [A_dec_lt : decidable_rel (@has_lt.lt A _)]
          {B : Type v} [B_lt : has_lt B] [B_dec_lt : decidable_rel (@has_lt.lt B _)]

include A_deceq A_lt A_dec_lt B_lt B_dec_lt

def less_than : A × B → A × B → Prop
| ⟨x₁, y₁⟩ ⟨x₂, y₂⟩ := if x₁ < x₂ then true else (if x₂ < x₁ then false else (y₁ < y₂))

instance : has_lt (A × B) := ⟨less_than⟩

def decidable_less_than : ∀ (p q : A × B), decidable (p < q)
| ⟨x₁, y₁⟩ ⟨x₂, y₂⟩ := show decidable (if x₁ < x₂ then true else (if x₂ < x₁ then false else (y₁ < y₂))), by apply_instance

instance : decidable_rel (@has_lt.lt (A × B) _) := decidable_less_than

end lt
end prod

lemma pair_neq_of_neq₁ {X Y : Type} {x₁ x₂ : X} {y₁ y₂ : Y} : x₁ ≠ x₂ → (x₁, y₁) ≠ (x₂, y₂) :=
assume (H : x₁ ≠ x₂) (H_contra : (x₁, y₁) = (x₂, y₂)),
by { injection H_contra with Hx Hy, exact H Hx }

namespace list
section lt
variables {A : Type*} [A_deceq : decidable_eq A] [A_lt : has_lt A] [A_dec_lt : decidable_rel (@has_lt.lt A _)]

include A_deceq A_lt A_dec_lt

def less_than : list A → list A → Prop
| []      (y::ys) := true
| _       []      := false
| (x::xs) (y::ys) := x < y ∨ (x = y ∧ less_than xs ys)

instance : has_lt (list A) := ⟨less_than⟩

def decidable_less_than : ∀ (xs ys : list A), decidable (xs < ys)
| []      (y::ys) := decidable.true
| []       []     := decidable.false
| (x::xs)  []     := decidable.false
| (x::xs) (y::ys) :=
show decidable (x < y ∨ (x = y ∧ less_than xs ys)), from
have H_lt : decidable (less_than xs ys), by apply decidable_less_than,
by apply_instance

instance : decidable_rel (@has_lt.lt (list A) _) := decidable_less_than

end lt

def p1 {X Y : Type} : list (X × Y) → list X
| [] := []
| (xy::xys) := xy.1 :: p1 xys

def p2 {X Y : Type} : list (X × Y) → list Y
| [] := []
| (xy::xys) := xy.2 :: p2 xys

lemma length_p1_same {X Y : Type} : ∀ (xs : list (X × Y)), length xs^.p1 = length xs
| []      := rfl
| (x::xs) := begin dsimp [length, p1], rw length_p1_same end

lemma length_p2_same {X Y : Type} : ∀ (xs : list (X × Y)), length xs^.p2 = length xs
| []      := rfl
| (x::xs) := begin dsimp [length, p2], rw length_p2_same end

def sumr {α : Type} [has_add α] [has_zero α] : list α → α
| [] := 0
| (x::xs) := x + sumr xs

def sumrd {α : Type} [has_add α] (d : α) : list α → α
| [] := d
| (x::xs) := x + sumrd xs

lemma sumrd_sumr {α : Type} [add_comm_group α] (d : α) : ∀ (xs : list α), sumrd d xs = d + sumr xs
| []      := begin dunfold sumrd sumr, rw add_zero end
| (x::xs) := begin dunfold sumrd sumr, rw sumrd_sumr, rw [-add_assoc, -add_assoc], rw add_comm x d end

def sumr₁ {α : Type} [has_add α] [has_zero α] : list α → α
| [] := 0
| [x] := x
| (x::y::xs) := x + sumr₁ (y::xs)

lemma sumr_sumr₁ {α : Type} [add_group α] : ∀ (xs : list α), sumr₁ xs = sumr xs
| [] := rfl
| [x] := begin dunfold sumr sumr₁, rw add_zero, end
| (x::y::xs) := begin dunfold sumr sumr₁, rw sumr_sumr₁, reflexivity end

def prod {α : Type*} [has_mul α] [has_one α] : list α → α :=
foldr has_mul.mul 1

lemma append_single {α : Type*} (x : α) (xs : list α) : [x] ++ xs = x :: xs := rfl

lemma append_nil_left {α : Type*} (xs : list α) : [] ++ xs = xs := rfl

lemma in_filter {α : Type*} (P : α → Prop) [decidable_pred P] : Π (xs : list α) (x : α), x ∈ xs → P x → x ∈ filter P xs
| []      x H_x_in HPx := H_x_in
| (y::ys) x H_x_in HPx :=
have Hx : x = y ∨ x ∈ ys, from iff.mp (mem_cons_iff _ _ _) H_x_in,
have Hy : P y ∨ ¬ (P y), from decidable.em _,
begin
dunfold filter,
cases Hx with H_eq H_in,
{ subst H_eq, simp [HPx] },
cases Hy with HPy HnPy,
{ simp [HPy], exact or.inr (in_filter _ _ H_in HPx) },
{ simp [HnPy], exact in_filter _ _ H_in HPx }
end

lemma of_in_filter {α : Type*} (P : α → Prop) [decidable_pred P] : Π (xs : list α) (x : α), x ∈ filter P xs → x ∈ xs ∧ P x
| []      x H_x_in := false.rec _ (not_mem_nil _ H_x_in)
| (y::ys) x H_x_in :=
have Hy : P y ∨ ¬ (P y), from decidable.em _,
begin
cases Hy with HPy HnPy,
dunfold filter at H_x_in,
simp [HPy] at H_x_in,
split,

cases H_x_in with H_eq H_in,
{ subst H_eq, apply mem_cons_self },
{ apply mem_cons_of_mem, exact (of_in_filter _ _ H_in)^.left },

cases H_x_in with H_eq H_in,
{ subst H_eq, exact HPy  },
{ exact (of_in_filter _ _ H_in)^.right  },

dunfold filter at H_x_in,
simp [HnPy] at H_x_in,
split,
apply mem_cons_of_mem, exact (of_in_filter _ _ H_x_in)^.left,
exact (of_in_filter _ _ H_x_in)^.right
end

def miota : ℕ → ℕ → list ℕ
| i 0     := []
| i (k+1) := i :: miota (i+1) k

def riota : ℕ → list ℕ
| 0 := []
| (n+1) := n :: riota n

lemma in_riota_lt : ∀ {idx n : ℕ}, idx ∈ riota n → idx < n
| idx 0     H_mem := false.rec _ (not_mem_nil (riota 0) H_mem)
| idx (n+1) H_mem :=
begin
dsimp [riota, list.mem] at H_mem,
cases H_mem with H_idx_eq H_mem,
{ rw H_idx_eq, apply nat.lt_succ_self },
apply nat.lt.step,
apply in_riota_lt,
exact H_mem
end

lemma map_compose {X Y Z : Type} (f : X → Y) (g : Y → Z) (xs : list X) : map g (map f xs) = map (λ x, g (f x)) xs := by apply map_map

lemma map_congr_fn {X Y : Type} (f g : X → Y) (xs : list X) : f = g → map f xs = map g xs := begin intro H, rw H end
lemma map_congr_fn_pred {X Y : Type} (f g : X → Y) : Π (xs : list X) (H : ∀ x, x ∈ xs → f x = g x), map f xs = map g xs
| []      H := rfl
| (x::xs) H :=
  show f x :: map f xs = g x :: map g xs, from
  have H_x : x ∈ x :: xs, by apply mem_cons_self,
  have H_rest : ∀ x, x ∈ xs → f x = g x,
    begin intros y H_y_in_xs, apply H, apply mem_cons_of_mem, exact H_y_in_xs end,
  begin rw H x H_x, rw (map_congr_fn_pred xs H_rest) end

def dnth {α : Type*} [inhabited α] : list α → nat → α
| []       n     := default α
| (a :: l) 0     := a
| (a :: l) (n+1) := dnth l n

lemma p1_dnth {α β : Type*} [inhabited α] [inhabited β] : ∀ (xs : list (α × β)) (idx : ℕ), (dnth xs idx).1 = dnth (p1 xs) idx
| []      _       := rfl
| (x::xs) 0       := rfl
| (x::xs) (idx+1) := begin dsimp [p1, dnth], apply p1_dnth end

lemma p2_dnth {α β : Type*} [inhabited α] [inhabited β] : ∀ (xs : list (α × β)) (idx : ℕ), (dnth xs idx).2 = dnth (p2 xs) idx
| []      _       := rfl
| (x::xs) 0       := rfl
| (x::xs) (idx+1) := begin dsimp [p2, dnth], apply p2_dnth end

def at_idx {X : Type} [inhabited X] (xs : list X) (idx : ℕ) (x : X) : Prop :=
  idx < length xs ∧ x = dnth xs idx

inductive elem_at_idx {X : Type} : Π (xs : list X) (idx : ℕ) (x : X), Prop
| base : ∀ (xs : list X) (x : X), elem_at_idx (x::xs) 0 x
| step : ∀ (xs : list X) (x y : X) (idx : ℕ), elem_at_idx xs idx y → elem_at_idx (x::xs) (idx+1) y

lemma elem_at_idx_of_at_idx {X : Type} [inhabited X] : ∀ {xs : list X} {idx : ℕ} {x : X},
  at_idx xs idx x → elem_at_idx xs idx x
| [] _ _ H_at_idx := false.rec _ (nat.not_lt_zero _ H_at_idx^.left)
| (x::xs) 0       x₀ H_at_idx := by { dsimp [at_idx, dnth] at H_at_idx, rw H_at_idx^.right, constructor }
| (x::xs) (idx+1) x₀ H_at_idx :=
begin
dsimp [at_idx, dnth] at H_at_idx,
apply elem_at_idx.step,
apply elem_at_idx_of_at_idx,
apply and.intro,
exact nat.lt_of_succ_lt_succ H_at_idx^.left,
exact H_at_idx^.right
end

lemma at_idx_0 {α : Type*} [inhabited α] {x : α} {xs : list α} : at_idx (x::xs) 0 x :=
begin dunfold at_idx, split, exact nat.zero_lt_succ (length xs), reflexivity end

lemma at_idx_inj {α : Type*} [inhabited α] {x x₁ x₂ : α} {xs : list α} : at_idx (x::xs) 0 x₁ → at_idx (x::xs) 0 x₂ → x₁ = x₂ :=
begin dunfold at_idx, intros H₁ H₂, rw [H₁^.right, H₂^.right] end

lemma at_idx_of_cons {α : Type*} [inhabited α] {x : α} {xs : list α} {y : α} {idx : ℕ} :
  at_idx (x::xs) (idx+1) y → at_idx xs idx y :=
begin
dunfold at_idx,
intro H,
cases H with H_lt H_dnth,
split,
exact nat.lt_of_succ_lt_succ H_lt,
rw H_dnth, reflexivity
end

lemma at_idx_cons {α : Type*} [inhabited α] {x : α} {xs : list α} {y : α} {idx : ℕ} :
  at_idx xs idx y → at_idx (x::xs) (idx+1) y :=
begin
dunfold at_idx,
intro H,
cases H with H_lt H_dnth,
split,
exact nat.succ_lt_succ H_lt,
rw H_dnth, reflexivity
end

lemma at_idx_p1 {α β : Type} [inhabited α] [inhabited β] {xs : list (α × β)} {x : α × β} {idx : ℕ} :
  at_idx xs idx x → at_idx xs^.p1 idx x.1 :=
begin
intro H_at_idx,
cases H_at_idx with H_lt H_eq,
apply and.intro,
rw length_p1_same, exact H_lt,
rw H_eq,
apply p1_dnth
end

lemma at_idx_p2 {α β : Type} [inhabited α] [inhabited β] {xs : list (α × β)} {x : α × β} {idx : ℕ} :
  at_idx xs idx x → at_idx xs^.p2 idx x.2 :=
begin
intro H_at_idx,
cases H_at_idx with H_lt H_eq,
apply and.intro,
rw length_p2_same, exact H_lt,
rw H_eq,
apply p2_dnth
end

lemma mem_of_at_idx {α : Type*} [inhabited α] {x : α} {xs : list α} {idx : ℕ} : at_idx xs idx x → x ∈ xs :=
begin
intro H_at_idx,
assert H_elem_at_idx : elem_at_idx xs idx x, { exact elem_at_idx_of_at_idx H_at_idx },
clear H_at_idx,
induction H_elem_at_idx with xs x xs idx' x y H_elem_at_idx IH,
apply mem_cons_self,
apply mem_cons_of_mem,
exact IH
end

lemma at_idx_over {X : Type} [inhabited X] {xs : list X} {idx : ℕ} {x : X} : at_idx xs idx x → ¬ (idx < length xs) → false :=
assume H_at_idx H_idx_big, H_idx_big H_at_idx^.left

instance decidable_at_idx {α : Type*} [decidable_eq α] [inhabited α] (xs : list α) (idx : ℕ) (x : α) : decidable (at_idx xs idx x) :=
if H : idx < length xs ∧ x = dnth xs idx then decidable.is_true H else decidable.is_false H

lemma mem_of_cons_same {α : Type*} {x : α} {xs : list α} : x ∈ x::xs := by { apply or.inl, reflexivity }

definition all_prop {α : Type*} (p : α → Prop) (l : list α) : Prop :=
foldr (λ a r, p a ∧ r) true l

def rcons {α : Type*} (a : α) : list α → list α
| []        := [a]
| (x :: xs) := x :: (rcons xs)

def dnth_all {A : Type} [inhabited A] (idxs : list ℕ) (xs : list A) : list A := map (λ idx, dnth xs idx) idxs

lemma mem_not_mem_neq {X : Type} {x₁ x₂ : X} {xs : list X} : x₁ ∈ xs → x₂ ∉ xs → x₁ ≠ x₂ :=
begin
intros H_in H_nin,
intro H_eq,
subst H_eq,
exact H_nin H_in
end

lemma nodup_cons_neq {X : Type} {x₁ x₂ : X} {xs : list X} : x₂ ∈ xs → nodup (x₁ :: xs) → x₁ ≠ x₂ :=
assume H_in H_nd,
have H_nin : x₁ ∉ xs, from not_mem_of_nodup_cons H_nd,
ne.symm $ mem_not_mem_neq H_in H_nin

lemma nodup_at_idx_neq {A : Type} [inhabited A] {x : A} {xs : list A} {y : A} {idx : ℕ} :
  nodup (x::xs) → at_idx (x::xs) (idx+1) y → y ≠ x :=
begin
intros H_nd H_at_idx,
note H_at_idx' := at_idx_of_cons H_at_idx,
assert H_in_xs : y ∈ xs,
apply mem_of_at_idx H_at_idx',
apply ne.symm,
apply nodup_cons_neq H_in_xs H_nd,
end

lemma sublist_cons_nil {X : Type*} {xs : list X} {x : X} : ¬ (x :: xs <+ []) :=
begin
intro H_contra,
note H := list.eq_nil_of_sublist_nil H_contra,
injection H
end

lemma disjoint_of_sublist_left {α : Type*} {l₁ l₂ l : list α} : l₁ <+ l → disjoint l l₂ → disjoint l₁ l₂ :=
λ ss d x xinl₁, d (subset_of_sublist ss xinl₁)

lemma disjoint_of_sublist_right {α : Type*} {l₁ l₂ l : list α} : l₂ <+ l → disjoint l₁ l → disjoint l₁ l₂ :=
λ ss d x xinl xinl₁, d xinl (subset_of_sublist ss xinl₁)

lemma nodup_append_sublist₁ {X : Type*} {ys zs : list X} (xs : list X) : nodup (ys ++ zs) → xs <+ ys → nodup (xs ++ zs) :=
assume H_nd H_sl,
have H_nd_xs : nodup xs, from nodup_of_sublist H_sl (nodup_of_nodup_append_left H_nd),
have H_nd_zs : nodup zs, from nodup_of_nodup_append_right H_nd,
have H_dj : disjoint xs zs, from disjoint_of_sublist_left H_sl (disjoint_of_nodup_append H_nd),
nodup_append_of_nodup_of_nodup_of_disjoint H_nd_xs H_nd_zs H_dj

lemma nodup_append_swap {X : Type} {xs₁ xs₂ : list X} {x : X} : nodup (xs₁ ++ (x :: xs₂)) → nodup ((x::xs₁) ++ xs₂) :=
by apply list.nodup_head

lemma nodup_mem_append₂ {X : Type} {x : X} {xs₁ xs₂ : list X} : nodup (xs₁ ++ xs₂) → x ∈ xs₂ → x ∉ xs₁ :=
assume (H_nd : nodup (xs₁ ++ xs₂)) (H₂ : x ∈ xs₂) (H₁ : x ∈ xs₁),
have H_dj : disjoint xs₁ xs₂, from disjoint_of_nodup_append H_nd,
H_dj H₁ H₂

lemma nodup_append_cons {X : Type} {xs₁ xs₂ : list X} {x : X} : nodup (xs₁ ++ (x :: xs₂)) → nodup (xs₁ ++ [x]) :=
assume H_nd,
have H_nd₁ : nodup xs₁, from nodup_of_nodup_append_left H_nd,
have H_dj : disjoint xs₁ (x :: xs₂), from disjoint_of_nodup_append H_nd,
have H_nin : x ∉ xs₁, from disjoint_right H_dj mem_of_cons_same,
begin apply nodup_app_comm, simp, apply nodup_cons H_nin H_nd₁ end

lemma nodup_append_cons_rest {X : Type} {xs₁ xs₂ : list X} {x : X} : nodup (xs₁ ++ (x :: xs₂)) → nodup (xs₁ ++ xs₂) :=
assume H_nd, nodup_of_nodup_cons (nodup_head H_nd)

lemma nodup_append_neq {X : Type} {xs₁ xs₂ : list X} {x₁ x₂ : X} : x₁ ∈ xs₁ → x₂ ∈ xs₂ → nodup (xs₁ ++ xs₂) → x₁ ≠ x₂ :=
assume H₁_in H₂_in H_nd,
have H_dj : disjoint xs₁ xs₂, from disjoint_of_nodup_append H_nd,
have H₁_nin : x₁ ∉ xs₂, from disjoint_left H_dj H₁_in,
ne.symm $ mem_not_mem_neq H₂_in H₁_nin

lemma nodup_append_cons_neq {X : Type} {xs : list X} {x₁ x₂ : X} : x₁ ∈ xs → nodup (xs ++ [x₂]) → x₁ ≠ x₂ :=
assume H₁_in H_nd,
have H_nd' : nodup (x₂ :: xs), from nodup_app_comm H_nd,
have H₂_nin : x₂ ∉ xs, from not_mem_of_nodup_cons H_nd',
mem_not_mem_neq H₁_in H₂_nin

lemma nodup_of_append_cons_cons {X : Type} {xs ys : list X} {y₁ y₂ : X} : nodup (xs ++ (y₁ :: y₂ :: ys)) → nodup (xs ++ (y₁ :: ys)) :=
assume H_nd,
have H_nd' : nodup (y₁ :: (xs ++ y₂ :: ys)), from nodup_head H_nd,
have H₁_nin : y₁ ∉ xs ++ y₂ :: ys, from not_mem_of_nodup_cons H_nd',
have H₁_nin₁ : y₁ ∉ xs, from not_mem_of_not_mem_append_left H₁_nin,
have H₁_nin₂ : y₁ ∉ ys, from not_mem_of_not_mem_cons (not_mem_of_not_mem_append_right H₁_nin),
have H_nd'' : nodup (xs ++ y₂ :: ys), from nodup_of_nodup_cons H_nd',
have H_nd''' : nodup (y₂ :: (xs ++ ys)), from nodup_head H_nd'',
have H_nd'''' : nodup (xs ++ ys), from nodup_of_nodup_cons H_nd''',
nodup_middle (nodup_cons (not_mem_append H₁_nin₁ H₁_nin₂) H_nd'''')

lemma map_filter_congr {α β : Type*} {f g : α → β} {p : α → Prop} [decidable_pred p] :
  ∀ {xs : list α}, (∀ x, x ∈ xs → p x → f x = g x) → map f (filter p xs) = map g (filter p xs)
| []      H := rfl
| (x::xs) H :=
begin
dsimp [map, filter],
assert H_px_em : p x ∨ ¬ (p x), { exact decidable.em _ },
cases H_px_em,
{ simph, apply congr_arg, apply map_filter_congr,
  intros y H_y_in_xs H_py,
  exact H y (mem_cons_of_mem _ H_y_in_xs) H_py },
{ simph, apply map_filter_congr,
  intros y H_y_in_xs H_py,
  exact H y (mem_cons_of_mem _ H_y_in_xs) H_py }
end

end list

namespace monad

def foldrM {M : Type → Type} [m : monad M] {X Y : Type} (f : Y → X → M Y) (init : Y) (xs : list X) : M Y :=
  list.foldr (λ (x : X) (k : Y → M Y) (y : Y), f y x >>= k) return xs init

end monad

@[simp]
def if_is_true {A : Type} (P : Prop) (p : P) (t e : A) :
  @ite P (is_true p) A t e = t := rfl

@[simp]
def if_is_false {A : Type} (P : Prop) (np : ¬ P) (t e : A) :
  @ite P (is_false np) A t e = e := rfl

def decidable_and (P Q : Prop) [dP : decidable P] [dQ : decidable Q] : decidable (P ∧ Q) :=
  match dP, dQ with
  | is_true p,   is_true q   := is_true (and.intro p q)
  | is_false np, _           := is_false (λ H : P ∧ Q, np H^.left)
  | _,           is_false nq := is_false (λ H : P ∧ Q, nq H^.right)
  end

def decidable_or (P Q : Prop) [dP : decidable P] [dQ : decidable Q] : decidable (P ∨ Q) :=
  match dP, dQ with
  | is_true p,   _           := is_true (or.inl p)
  | _,           is_true q   := is_true (or.inr q)
  | is_false np, is_false nq := is_false (λ H : P ∨ Q, or.rec_on H (λ p, np p) (λ q, nq q))
  end


/-
Copyright (c) 2018 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin, Simon Hudon
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.list.basic
import Mathlib.PostPort

namespace Mathlib

namespace list

/--
tfae: The Following (propositions) Are Equivalent.

The `tfae_have` and `tfae_finish` tactics can be useful in proofs with `tfae` goals.
-/
def tfae (l : List Prop) := ∀ (x : Prop), x ∈ l → ∀ (y : Prop), y ∈ l → (x ↔ y)

theorem tfae_nil : tfae [] := forall_mem_nil fun (x : Prop) => ∀ (y : Prop), y ∈ [] → (x ↔ y)

theorem tfae_singleton (p : Prop) : tfae [p] := sorry

theorem tfae_cons_of_mem {a : Prop} {b : Prop} {l : List Prop} (h : b ∈ l) :
    tfae (a :: l) ↔ (a ↔ b) ∧ tfae l :=
  sorry

theorem tfae_cons_cons {a : Prop} {b : Prop} {l : List Prop} :
    tfae (a :: b :: l) ↔ (a ↔ b) ∧ tfae (b :: l) :=
  tfae_cons_of_mem (Or.inl rfl)

theorem tfae_of_forall (b : Prop) (l : List Prop) (h : ∀ (a : Prop), a ∈ l → (a ↔ b)) : tfae l :=
  fun (a₁ : Prop) (h₁ : a₁ ∈ l) (a₂ : Prop) (h₂ : a₂ ∈ l) =>
    iff.trans (h a₁ h₁) (iff.symm (h a₂ h₂))

theorem tfae_of_cycle {a : Prop} {b : Prop} {l : List Prop} :
    chain (fun (_x _y : Prop) => _x → _y) a (b :: l) → (ilast' b l → a) → tfae (a :: b :: l) :=
  sorry

theorem tfae.out {l : List Prop} (h : tfae l) (n₁ : ℕ) (n₂ : ℕ) {a : Prop} {b : Prop}
    (h₁ :
      autoParam (nth l n₁ = some a)
        (Lean.Syntax.ident Lean.SourceInfo.none
          (String.toSubstring "Mathlib.tactic.interactive.refl")
          (Lean.Name.mkStr
            (Lean.Name.mkStr
              (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "tactic")
              "interactive")
            "refl")
          []))
    (h₂ :
      autoParam (nth l n₂ = some b)
        (Lean.Syntax.ident Lean.SourceInfo.none
          (String.toSubstring "Mathlib.tactic.interactive.refl")
          (Lean.Name.mkStr
            (Lean.Name.mkStr
              (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "tactic")
              "interactive")
            "refl")
          [])) :
    a ↔ b :=
  h a (nth_mem h₁) b (nth_mem h₂)

end Mathlib


/-
Copyright (c) 2017 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Tim Baumann, Stephen Morgan, Scott Morrison

Defines a functor between categories.

(As it is a 'bundled' object rather than the `is_functorial` typeclass parametrised
by the underlying function on objects, the name is capitalised.)

Introduces notations
  `C ⥤ D` for the type of all functors from `C` to `D`.
    (I would like a better arrow here, unfortunately ⇒ (`\functor`) is taken by core.)
-/

import category_theory.category
import tactic.tidy

namespace category_theory

universes v v₁ v₂ v₃ u u₁ u₂ u₃ -- declare the `v`'s first; see `category_theory.category` for an explanation

/--
`functor C D` represents a functor between categories `C` and `D`.

To apply a functor `F` to an object use `F.obj X`, and to a morphism use `F.map f`.

The axiom `map_id_lemma` expresses preservation of identities, and
`map_comp_lemma` expresses functoriality.
-/
structure functor (C : Type u₁) [category.{v₁} C] (D : Type u₂) [category.{v₂} D] :
  Type (max u₁ v₁ u₂ v₂) :=
(obj       : C → D)
(map       : Π {X Y : C}, (X ⟶ Y) → ((obj X) ⟶ (obj Y)))
(map_id'   : ∀ (X : C), map (𝟙 X) = 𝟙 (obj X) . obviously)
(map_comp' : ∀ {X Y Z : C} (f : X ⟶ Y) (g : Y ⟶ Z), map (f ≫ g) = (map f) ≫ (map g) . obviously)

-- A functor is basically a function, so give ⥤ a similar precedence to → (25).
-- For example, `C × D ⥤ E` should parse as `(C × D) ⥤ E` not `C × (D ⥤ E)`.
infixr ` ⥤ `:26 := functor       -- type as \func --

restate_axiom functor.map_id'
attribute [simp] functor.map_id
restate_axiom functor.map_comp'
attribute [simp] functor.map_comp

namespace functor

section
variables (C : Type u₁) [𝒞 : category.{v₁} C]
include 𝒞

/-- `functor.id C` is the identity functor on a category `C`. -/
protected def id : C ⥤ C :=
{ obj := λ X, X,
  map := λ _ _ f, f }

variable {C}

@[simp] lemma id_obj (X : C) : (functor.id C).obj X = X := rfl
@[simp] lemma id_map {X Y : C} (f : X ⟶ Y) : (functor.id C).map f = f := rfl
end

section
variables {C : Type u₁} [𝒞 : category.{v₁} C]
          {D : Type u₂} [𝒟 : category.{v₂} D]
          {E : Type u₃} [ℰ : category.{v₃} E]
include 𝒞 𝒟 ℰ

/--
`F ⋙ G` is the composition of a functor `F` and a functor `G` (`F` first, then `G`).
-/
def comp (F : C ⥤ D) (G : D ⥤ E) : C ⥤ E :=
{ obj := λ X, G.obj (F.obj X),
  map := λ _ _ f, G.map (F.map f) }

infixr ` ⋙ `:80 := comp

@[simp] lemma comp_obj (F : C ⥤ D) (G : D ⥤ E) (X : C) : (F ⋙ G).obj X = G.obj (F.obj X) := rfl
@[simp] lemma comp_map (F : C ⥤ D) (G : D ⥤ E) (X Y : C) (f : X ⟶ Y) :
  (F ⋙ G).map f = G.map (F.map f) := rfl
end

section
variables (C : Type u₁) [𝒞 : category.{v₁} C]
include 𝒞

@[simp] def ulift_down : (ulift.{u₂} C) ⥤ C :=
{ obj := λ X, X.down,
  map := λ X Y f, f }

@[simp] def ulift_up : C ⥤ (ulift.{u₂} C) :=
{ obj := λ X, ⟨ X ⟩,
  map := λ X Y f, f }

end

end functor

end category_theory


/-
Copyright © 2018 François G. Dorais. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
-/

import .basic .subst

universe u
variables {σ : Type u} {sig : σ → ℕ} {I : Type*} (ax : I → eqn sig)
include sig ax

definition models (e : eqn sig) : Prop :=
∀ {α : Type (u+1)} (a : alg sig α), (∀ i, a ⊧ ax i) → (a ⊧ e)

infix ` ⊨ `:20 := models

lemma model.axiom (i : I) : ax ⊨ ax i := λ _ _ ha, ha i

namespace model

lemma reflexivity (t : term sig) : ax ⊨ t ≡ t :=
λ _ _ _ _, rfl

lemma symmetry {{t u : term sig}} : (ax ⊨ t ≡ u) → (ax ⊨ u ≡ t) :=
λ h _ a ha val, eq.symm (h a ha val)

lemma transitivity {{t u v : term sig}} : (ax ⊨ t ≡ u) → (ax ⊨ u ≡ v) → (ax ⊨ t ≡ v) :=
λ htu huv α a ha val, eq.trans (htu a ha val) (huv a ha val)

lemma substitiution (sub : ℕ → term sig) {{t u : term sig}} :
(ax ⊨ t ≡ u) → (ax ⊨ subst sub t ≡ subst sub u) :=
λ h _ a ha val,
calc
eval a val (subst sub t)
    = eval a (λ n, eval a val (sub n)) t  : by rw subst_eval
... = eval a (λ n, eval a val (sub n)) u  : by rw h a ha
... = eval a val (subst sub u)            : by rw subst_eval

lemma replacement {{sub₁ sub₂ : ℕ → term sig}} :
(∀ n, ax ⊨ (sub₁ n) ≡ (sub₂ n)) → (∀ t, ax ⊨ subst sub₁ t ≡ subst sub₂ t)
| h (term.var n) :=
  λ _ a ha val, h n a ha val
| h (term.app s ts) :=
  λ _ a ha val,
  have tup.map (eval a val) (tup.map (subst sub₁) ts) = tup.map (eval a val) (tup.map (subst sub₂) ts),
  from tup.ext (λ i, replacement h (ts i) a ha val),
  calc
  eval a val (subst sub₁ (term.app s ts))
      = eval a val (term.app s (tup.map (subst sub₁) ts)) : by rw subst_app
  ... = a.app s (tup.map (eval a val) (tup.map (subst sub₁) ts)) : by rw eval_app
  ... = a.app s (tup.map (eval a val) (tup.map (subst sub₂) ts)) : by rw this
  ... = eval a val (term.app s (tup.map (subst sub₂) ts)) : by rw eval_app
  ... = eval a val (subst sub₂ (term.app s ts)) : by rw subst_app

end model