import data.subtype

namespace set

constant set : Type.{1}

constant empty : set
constant pair : set → set → set
constant filter : set → (set → Prop) → set
constant bigunion : set → set
constant powerset : set → set
constant inf : set

definition function := { f : set → set → Prop | ∀ x y z, f x y = f x z → y = z }
constant map : function → set → set

constant mem : set → set → Prop

notation `∅` := empty
infix `∈` := mem
notation a ∉ b := ¬ mem a b

definition subset (s1 s2 : set) := ∀ {u}, u ∈ s1 → u ∈ s2
infix `⊆` := subset

definition singleton (s : set) := bigunion (pair s ∅)

definition intersection (s1 s2 : set) := filter s1 (λ x, x ∈ s2)
notation a ∩ b := intersection a b

definition intersect_in_both : ∀ {s1 s2 : set} {x : set}, x ∈ s1 ∩ s2 → x ∈ s1 ∧ x ∈ s2 := sorry

definition union (s1 s2 : set) := bigunion (pair s1 s2)
notation a ∪ b := union a b

-- Missing axiom
axiom axiom_emptyset : ∀ x, x ∉ ∅

-- 1. Axiom of Extensionality: If X and Y have the same elements, then X=Y.
axiom axiom_extensionality (X Y : set) : (∀ u, u ∈ X ↔ u ∈ Y) → X = Y

-- 2. Axiom of the Unordered Pair: For any a and b there exists a set {a,b} that contains exactly a and b. (also called Axiom of Pairing)
axiom axiom_pair : ∀ a b x, x ∈ pair a b ↔ (x = a ∨ x = b)

-- 3. Axiom of Subsets: If phi is a property (with parameter p), then for any  X and p there exists a set Y={u in X:phi(u,p)} that contains all those u in X that have the property phi. (also called Axiom of Separation or Axiom of Comprehension)
axiom axiom_filter (X : set) : ∀ φ u, (u ∈ filter X φ) ↔ (u ∈ X ∧ φ u)

-- 4. Axiom of the Sum Set: For any X there exists a set Y= union X, the union of all elements of X. (also called Axiom of Union)
axiom axiom_unions (X : set) : ∀ u, u ∈ bigunion X ↔ ∃ z, z ∈ X ∧ u ∈ z

-- 5. Axiom of the Power Set: For any X there exists a set Y=P(X), the set of all subsets of X.
axiom axiom_powerset (X : set) : ∀ u, u ∈ powerset X ↔ u ⊆ X

-- 6. Axiom of Infinity: There exists an infinite set.
axiom axiom_infinity : ∅ ∈ inf ∧ ∀ x, x ∈ inf → pair x (singleton x) ∈ inf

-- 7. Axiom of Replacement: If F is a function, then for any X there exists a set Y=F[X]={F(x):x in X}.
-- (Note: this is a type theory function, not a set function. Would just require coercion and choice to make it set-theoretic)
axiom axiom_replacement (X Y : set) : ∀ F y, y ∈ Y ↔ ∃ x, x ∈ X ∧ F x y

-- 8. Axiom of Foundation: Every nonempty set has an  in -minimal element. (also called Axiom of Regularity)
axiom axiom_foundation : ∀ S, S ≠ ∅ → ∃ x, x ∈ S ∧ x ∩ S = ∅

end set

namespace set_examples

open set

theorem subset_refl : ∀ A, A ⊆ A :=
  -- Proof. Let A be an arbitrary set, and let x be an arbitrary member of A.
  assume A x `x ∈ A`,
  -- It is a tautology that x ∈ A → x ∈ A, so, by definition, A ⊆ A.
  show x ∈ A, from `x ∈ A`

theorem subset_trans : ∀ (A B C : set), subset A B → subset B C → subset A C :=
  -- Proof. Let A, B, and C be arbitrary sets such that A ⊆ B and B ⊆ C.
  assume A B C `A ⊆ B` `B ⊆ C`,
  -- Let x be an arbitrary member of A.
  assume x `x ∈ A`,
  -- Then x ∈ B because A ⊆ B.
  have x_in_B : x ∈ B, from `A ⊆ B` `x ∈ A`,
  -- But then x ∈ C since B ⊆ C.
  have x_in_C : x ∈ C, from `B ⊆ C` `x ∈ B`,
  -- Therefore, x ∈ C for all x ∈ A, so, by definition, A ⊆ C.
  show x ∈ C, from x_in_C

theorem inter_subset : ∀ (A B : set), A ∩ B ⊆ A :=
  -- Proof. Let A and B be arbitrary sets. Let x be an arbitrary member of A ∩ B.
  assume A B x `x ∈ A ∩ B`,
  -- Then, by definition, x ∈ A and x ∈ B,
  obtain `x ∈ A` `x ∈ B`, from intersect_in_both `x ∈ A ∩ B`,
  -- so, of course, x ∈ A.
  -- So, we have x ∈ A ∩ B → x ∈ A, so, by definition, A ∩ B ⊆ A.
  show x ∈ A, from `x ∈ A`

theorem inter_sub_powerset : ∀ A B, A ∩ B ⊆ powerset A ∩ powerset B :=
  -- Proof. Let A and B be arbitrary sets.
  assume A B,
  -- A ∩ B ⊆ A, so A ∩ B ∈ P(A) by the definition of powerset.
  have A ∩ B ∈ powerset A, from sorry, -- iff.elim_left (@axiom_powerset A (inter_subset A B)),
  -- Similarly, A ∩ B ∈ P(B).
  have A ∩ B ∈ powerset B, from sorry, -- same but with commutativity
  -- Hence A ∩ B ⊆ P(A) ∩ P(B).
  sorry

lemma subset_eq : ∀ {A B}, A ⊆ B → B ⊆ A → A = B := sorry

theorem powerset_inter_splits : ∀ A B, powerset (A ∩ B) = powerset A ∩ powerset B :=
  -- Proof. Let A and B be arbitrary sets.
  assume A B,
  -- We prove set inclusion in both directions.
  -- First, to see that P(A ∩ B) ⊆ P(A) ∩ P(B), let S be an arbitrary member of P(A ∩ B).
  have H1 : powerset (A ∩ B) ⊆ powerset A ∩ powerset B, from
    assume S S_in_LHS,
    -- Then S ⊆ A ∩ B,
    have H1a : S ⊆ A ∩ B, from sorry,
    have H1b : A ∩ B ⊆ A, from sorry,
    have H1c : S ⊆ A, from sorry,
    have H1d : S ∈ powerset A, from sorry,
    sorry,
  sorry
end set_examples


/-
Copyright (c) 2020 Anne Baanen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Anne Baanen
-/

import ring_theory.algebraic
import ring_theory.localization

/-!
# Ideals over/under ideals

This file concerns ideals lying over other ideals.
Let `f : R →+* S` be a ring homomorphism (typically a ring extension), `I` an ideal of `R` and
`J` an ideal of `S`. We say `J` lies over `I` (and `I` under `J`) if `I` is the `f`-preimage of `J`.
This is expressed here by writing `I = J.comap f`.

## Implementation notes

The proofs of the `comap_ne_bot` and `comap_lt_comap` families use an approach
specific for their situation: we construct an element in `I.comap f` from the
coefficients of a minimal polynomial.
Once mathlib has more material on the localization at a prime ideal, the results
can be proven using more general going-up/going-down theory.
-/

variables {R : Type*} [comm_ring R]

namespace ideal

open polynomial
open submodule

section comm_ring
variables {S : Type*} [comm_ring S] {f : R →+* S} {I J : ideal S}

lemma coeff_zero_mem_comap_of_root_mem_of_eval_mem {r : S} (hr : r ∈ I) {p : polynomial R}
  (hp : p.eval₂ f r ∈ I) : p.coeff 0 ∈ I.comap f :=
begin
  rw [←p.div_X_mul_X_add, eval₂_add, eval₂_C, eval₂_mul, eval₂_X] at hp,
  refine mem_comap.mpr ((I.add_mem_iff_right _).mp hp),
  exact I.mul_mem_left _ hr
end

lemma coeff_zero_mem_comap_of_root_mem {r : S} (hr : r ∈ I) {p : polynomial R}
  (hp : p.eval₂ f r = 0) : p.coeff 0 ∈ I.comap f :=
coeff_zero_mem_comap_of_root_mem_of_eval_mem hr (hp.symm ▸ I.zero_mem)

lemma exists_coeff_ne_zero_mem_comap_of_non_zero_divisor_root_mem {r : S}
  (r_non_zero_divisor : ∀ {x}, x * r = 0 → x = 0) (hr : r ∈ I)
  {p : polynomial R} : ∀ (p_ne_zero : p ≠ 0) (hp : p.eval₂ f r = 0),
  ∃ i, p.coeff i ≠ 0 ∧ p.coeff i ∈ I.comap f :=
begin
  refine p.rec_on_horner _ _ _,
  { intro h, contradiction },
  { intros p a coeff_eq_zero a_ne_zero ih p_ne_zero hp,
    refine ⟨0, _, coeff_zero_mem_comap_of_root_mem hr hp⟩,
    simp [coeff_eq_zero, a_ne_zero] },
  { intros p p_nonzero ih mul_nonzero hp,
    rw [eval₂_mul, eval₂_X] at hp,
    obtain ⟨i, hi, mem⟩ := ih p_nonzero (r_non_zero_divisor hp),
    refine ⟨i + 1, _, _⟩; simp [hi, mem] }
end

/-- Let `P` be an ideal in `R[x]`.  The map
`R[x]/P → (R / (P ∩ R))[x] / (P / (P ∩ R))`
is injective.
-/
lemma injective_quotient_le_comap_map (P : ideal (polynomial R)) :
  function.injective ((map (map_ring_hom (quotient.mk (P.comap C))) P).quotient_map
    (map_ring_hom (quotient.mk (P.comap C))) le_comap_map) :=
begin
  refine quotient_map_injective' (le_of_eq _),
  rw comap_map_of_surjective
    (map_ring_hom (quotient.mk (P.comap C))) (map_surjective _ quotient.mk_surjective),
  refine le_antisymm (sup_le le_rfl _) (le_sup_left_of_le le_rfl),
  refine λ p hp, polynomial_mem_ideal_of_coeff_mem_ideal P p (λ n, quotient.eq_zero_iff_mem.mp _),
  simpa only [coeff_map, coe_map_ring_hom] using ext_iff.mp (ideal.mem_bot.mp (mem_comap.mp hp)) n,
end

/--
The identity in this lemma asserts that the "obvious" square
```
    R    → (R / (P ∩ R))
    ↓          ↓
R[x] / P → (R / (P ∩ R))[x] / (P / (P ∩ R))
```
commutes.  It is used, for instance, in the proof of `quotient_mk_comp_C_is_integral_of_jacobson`,
in the file `ring_theory/jacobson`.
-/
lemma quotient_mk_maps_eq (P : ideal (polynomial R)) :
  ((quotient.mk (map (map_ring_hom (quotient.mk (P.comap C))) P)).comp C).comp
    (quotient.mk (P.comap C)) =
  ((map (map_ring_hom (quotient.mk (P.comap C))) P).quotient_map
    (map_ring_hom (quotient.mk (P.comap C))) le_comap_map).comp ((quotient.mk P).comp C) :=
begin
  refine ring_hom.ext (λ x, _),
  repeat { rw [ring_hom.coe_comp, function.comp_app] },
  rw [quotient_map_mk, coe_map_ring_hom, map_C],
end

/--
This technical lemma asserts the existence of a polynomial `p` in an ideal `P ⊂ R[x]`
that is non-zero in the quotient `R / (P ∩ R) [x]`.  The assumptions are equivalent to
`P ≠ 0` and `P ∩ R = (0)`.
-/
lemma exists_nonzero_mem_of_ne_bot {P : ideal (polynomial R)}
  (Pb : P ≠ ⊥) (hP : ∀ (x : R), C x ∈ P → x = 0) :
  ∃ p : polynomial R, p ∈ P ∧ (polynomial.map (quotient.mk (P.comap C)) p) ≠ 0 :=
begin
  obtain ⟨m, hm⟩ := submodule.nonzero_mem_of_bot_lt (bot_lt_iff_ne_bot.mpr Pb),
  refine ⟨m, submodule.coe_mem m, λ pp0, hm (submodule.coe_eq_zero.mp _)⟩,
  refine (is_add_group_hom.injective_iff (polynomial.map (quotient.mk (P.comap C)))).mp _ _ pp0,
  refine map_injective _ ((quotient.mk (P.comap C)).injective_iff_ker_eq_bot.mpr _),
  rw [mk_ker],
  exact (submodule.eq_bot_iff _).mpr (λ x hx, hP x (mem_comap.mp hx)),
end

end comm_ring

section integral_domain
variables {S : Type*} [integral_domain S] {f : R →+* S} {I J : ideal S}

lemma exists_coeff_ne_zero_mem_comap_of_root_mem {r : S} (r_ne_zero : r ≠ 0) (hr : r ∈ I)
  {p : polynomial R} : ∀ (p_ne_zero : p ≠ 0) (hp : p.eval₂ f r = 0),
  ∃ i, p.coeff i ≠ 0 ∧ p.coeff i ∈ I.comap f :=
exists_coeff_ne_zero_mem_comap_of_non_zero_divisor_root_mem
  (λ _ h, or.resolve_right (mul_eq_zero.mp h) r_ne_zero) hr

lemma exists_coeff_mem_comap_sdiff_comap_of_root_mem_sdiff
  [is_prime I] (hIJ : I ≤ J) {r : S} (hr : r ∈ (J : set S) \ I)
  {p : polynomial R} (p_ne_zero : p.map (quotient.mk (I.comap f)) ≠ 0) (hpI : p.eval₂ f r ∈ I) :
  ∃ i, p.coeff i ∈ (J.comap f : set R) \ (I.comap f) :=
begin
  obtain ⟨hrJ, hrI⟩ := hr,
  have rbar_ne_zero : quotient.mk I r ≠ 0 := mt (quotient.mk_eq_zero I).mp hrI,
  have rbar_mem_J : quotient.mk I r ∈ J.map (quotient.mk I) := mem_map_of_mem hrJ,
  have quotient_f : ∀ x ∈ I.comap f, (quotient.mk I).comp f x = 0,
  { simp [quotient.eq_zero_iff_mem] },
  have rbar_root : (p.map (quotient.mk (I.comap f))).eval₂
    (quotient.lift (I.comap f) _ quotient_f)
    (quotient.mk I r) = 0,
  { convert quotient.eq_zero_iff_mem.mpr hpI,
    exact trans (eval₂_map _ _ _) (hom_eval₂ p f (quotient.mk I) r).symm },
  obtain ⟨i, ne_zero, mem⟩ :=
    exists_coeff_ne_zero_mem_comap_of_root_mem rbar_ne_zero rbar_mem_J p_ne_zero rbar_root,
  rw coeff_map at ne_zero mem,
  refine ⟨i, (mem_quotient_iff_mem hIJ).mp _, mt _ ne_zero⟩,
  { simpa using mem },
  simp [quotient.eq_zero_iff_mem],
end

lemma comap_ne_bot_of_root_mem {r : S} (r_ne_zero : r ≠ 0) (hr : r ∈ I)
  {p : polynomial R} (p_ne_zero : p ≠ 0) (hp : p.eval₂ f r = 0) :
  I.comap f ≠ ⊥ :=
λ h, let ⟨i, hi, mem⟩ := exists_coeff_ne_zero_mem_comap_of_root_mem r_ne_zero hr p_ne_zero hp in
absurd (mem_bot.mp (eq_bot_iff.mp h mem)) hi

lemma comap_lt_comap_of_root_mem_sdiff [I.is_prime] (hIJ : I ≤ J)
  {r : S} (hr : r ∈ (J : set S) \ I)
  {p : polynomial R} (p_ne_zero : p.map (quotient.mk (I.comap f)) ≠ 0) (hp : p.eval₂ f r ∈ I) :
  I.comap f < J.comap f :=
let ⟨i, hJ, hI⟩ := exists_coeff_mem_comap_sdiff_comap_of_root_mem_sdiff hIJ hr p_ne_zero hp
in set_like.lt_iff_le_and_exists.mpr ⟨comap_mono hIJ, p.coeff i, hJ, hI⟩

variables [algebra R S]

lemma comap_ne_bot_of_algebraic_mem {x : S}
  (x_ne_zero : x ≠ 0) (x_mem : x ∈ I) (hx : is_algebraic R x) : I.comap (algebra_map R S) ≠ ⊥ :=
let ⟨p, p_ne_zero, hp⟩ := hx
in comap_ne_bot_of_root_mem x_ne_zero x_mem p_ne_zero hp

lemma comap_ne_bot_of_integral_mem [nontrivial R] {x : S}
  (x_ne_zero : x ≠ 0) (x_mem : x ∈ I) (hx : is_integral R x) : I.comap (algebra_map R S) ≠ ⊥ :=
comap_ne_bot_of_algebraic_mem x_ne_zero x_mem (hx.is_algebraic R)

lemma eq_bot_of_comap_eq_bot [nontrivial R] (hRS : algebra.is_integral R S)
  (hI : I.comap (algebra_map R S) = ⊥) : I = ⊥ :=
begin
  refine eq_bot_iff.2 (λ x hx, _),
  by_cases hx0 : x = 0,
  { exact hx0.symm ▸ ideal.zero_mem ⊥ },
  { exact absurd hI (comap_ne_bot_of_integral_mem hx0 hx (hRS x)) }
end

lemma mem_of_one_mem (h : (1 : S) ∈ I) (x) : x ∈ I :=
(I.eq_top_iff_one.mpr h).symm ▸ mem_top

lemma comap_lt_comap_of_integral_mem_sdiff [hI : I.is_prime] (hIJ : I ≤ J)
  {x : S} (mem : x ∈ (J : set S) \ I) (integral : is_integral R x) :
  I.comap (algebra_map R S) < J.comap (algebra_map _ _) :=
begin
  obtain ⟨p, p_monic, hpx⟩ := integral,
  refine comap_lt_comap_of_root_mem_sdiff hIJ mem _ _,
  swap,
  { apply map_monic_ne_zero p_monic,
    apply quotient.nontrivial,
    apply mt comap_eq_top_iff.mp,
    apply hI.1 },
  convert I.zero_mem
end

lemma is_maximal_of_is_integral_of_is_maximal_comap
  (hRS : algebra.is_integral R S) (I : ideal S) [I.is_prime]
  (hI : is_maximal (I.comap (algebra_map R S))) : is_maximal I :=
⟨⟨mt comap_eq_top_iff.mpr hI.1.1,
  λ J I_lt_J, let ⟨I_le_J, x, hxJ, hxI⟩ := set_like.lt_iff_le_and_exists.mp I_lt_J in
  comap_eq_top_iff.1 $ hI.1.2 _ (comap_lt_comap_of_integral_mem_sdiff I_le_J ⟨hxJ, hxI⟩ (hRS x))⟩⟩

lemma is_maximal_of_is_integral_of_is_maximal_comap' {R S : Type*} [comm_ring R] [integral_domain S]
  (f : R →+* S) (hf : f.is_integral) (I : ideal S) [hI' : I.is_prime]
  (hI : is_maximal (I.comap f)) : is_maximal I :=
@is_maximal_of_is_integral_of_is_maximal_comap R _ S _ f.to_algebra hf I hI' hI

lemma is_maximal_comap_of_is_integral_of_is_maximal (hRS : algebra.is_integral R S)
  (I : ideal S) [hI : I.is_maximal] : is_maximal (I.comap (algebra_map R S)) :=
begin
  refine quotient.maximal_of_is_field _ _,
  haveI : is_prime (I.comap (algebra_map R S)) := comap_is_prime _ _,
  exact is_field_of_is_integral_of_is_field (is_integral_quotient_of_is_integral hRS)
    algebra_map_quotient_injective (by rwa ← quotient.maximal_ideal_iff_is_field_quotient),
end

lemma is_maximal_comap_of_is_integral_of_is_maximal' {R S : Type*} [comm_ring R] [integral_domain S]
  (f : R →+* S) (hf : f.is_integral) (I : ideal S) (hI : I.is_maximal) : is_maximal (I.comap f) :=
@is_maximal_comap_of_is_integral_of_is_maximal R _ S _ f.to_algebra hf I hI

lemma integral_closure.comap_ne_bot [nontrivial R] {I : ideal (integral_closure R S)}
  (I_ne_bot : I ≠ ⊥) : I.comap (algebra_map R (integral_closure R S)) ≠ ⊥ :=
let ⟨x, x_mem, x_ne_zero⟩ := I.ne_bot_iff.mp I_ne_bot in
comap_ne_bot_of_integral_mem x_ne_zero x_mem (integral_closure.is_integral x)

lemma integral_closure.eq_bot_of_comap_eq_bot [nontrivial R] {I : ideal (integral_closure R S)} :
  I.comap (algebra_map R (integral_closure R S)) = ⊥ → I = ⊥ :=
imp_of_not_imp_not _ _ integral_closure.comap_ne_bot

lemma integral_closure.comap_lt_comap {I J : ideal (integral_closure R S)} [I.is_prime]
  (I_lt_J : I < J) :
  I.comap (algebra_map R (integral_closure R S)) < J.comap (algebra_map _ _) :=
let ⟨I_le_J, x, hxJ, hxI⟩ := set_like.lt_iff_le_and_exists.mp I_lt_J in
comap_lt_comap_of_integral_mem_sdiff I_le_J ⟨hxJ, hxI⟩ (integral_closure.is_integral x)

lemma integral_closure.is_maximal_of_is_maximal_comap
  (I : ideal (integral_closure R S)) [I.is_prime]
  (hI : is_maximal (I.comap (algebra_map R (integral_closure R S)))) : is_maximal I :=
is_maximal_of_is_integral_of_is_maximal_comap (λ x, integral_closure.is_integral x) I hI

/-- `comap (algebra_map R S)` is a surjection from the prime spec of `R` to prime spec of `S`.
`hP : (algebra_map R S).ker ≤ P` is a slight generalization of the extension being injective -/
lemma exists_ideal_over_prime_of_is_integral' (H : algebra.is_integral R S)
  (P : ideal R) [is_prime P] (hP : (algebra_map R S).ker ≤ P) :
  ∃ (Q : ideal S), is_prime Q ∧ Q.comap (algebra_map R S) = P :=
begin
  have hP0 : (0 : S) ∉ algebra.algebra_map_submonoid S P.prime_compl,
  { rintro ⟨x, ⟨hx, x0⟩⟩,
    exact absurd (hP x0) hx },
  let Rₚ := localization P.prime_compl,
  let f := localization.of P.prime_compl,
  let Sₚ := localization (algebra.algebra_map_submonoid S P.prime_compl),
  let g := localization.of (algebra.algebra_map_submonoid S P.prime_compl),
  letI : integral_domain (localization (algebra.algebra_map_submonoid S P.prime_compl)) :=
    localization_map.integral_domain_localization (le_non_zero_divisors_of_domain hP0),
  obtain ⟨Qₚ : ideal Sₚ, Qₚ_maximal⟩ := exists_maximal Sₚ,
  haveI Qₚ_max : is_maximal (comap _ Qₚ) := @is_maximal_comap_of_is_integral_of_is_maximal Rₚ _ Sₚ _
    (localization_algebra P.prime_compl f g)
    (is_integral_localization f g H) _ Qₚ_maximal,
  refine ⟨comap g.to_map Qₚ, ⟨comap_is_prime g.to_map Qₚ, _⟩⟩,
  convert localization.at_prime.comap_maximal_ideal,
  rw [comap_comap, ← local_ring.eq_maximal_ideal Qₚ_max, ← f.map_comp _],
  refl
end

/-- More general going-up theorem than `exists_ideal_over_prime_of_is_integral'`.
TODO: Version of going-up theorem with arbitrary length chains (by induction on this)?
  Not sure how best to write an ascending chain in Lean -/
theorem exists_ideal_over_prime_of_is_integral (H : algebra.is_integral R S)
  (P : ideal R) [is_prime P] (I : ideal S) [is_prime I] (hIP : I.comap (algebra_map R S) ≤ P) :
  ∃ Q ≥ I, is_prime Q ∧ Q.comap (algebra_map R S) = P :=
begin
  obtain ⟨Q' : ideal I.quotient, ⟨Q'_prime, hQ'⟩⟩ := @exists_ideal_over_prime_of_is_integral'
    (I.comap (algebra_map R S)).quotient _ I.quotient _
    ideal.quotient_algebra
    (is_integral_quotient_of_is_integral H)
    (map (quotient.mk (I.comap (algebra_map R S))) P)
    (map_is_prime_of_surjective quotient.mk_surjective (by simp [hIP]))
    (le_trans
      (le_of_eq ((ring_hom.injective_iff_ker_eq_bot _).1 algebra_map_quotient_injective))
      bot_le),
  haveI := Q'_prime,
  refine ⟨Q'.comap _, le_trans (le_of_eq mk_ker.symm) (ker_le_comap _), ⟨comap_is_prime _ Q', _⟩⟩,
  rw comap_comap,
  refine trans _ (trans (congr_arg (comap (quotient.mk (comap (algebra_map R S) I))) hQ') _),
  { simpa [comap_comap] },
  { refine trans (comap_map_of_surjective _ quotient.mk_surjective _) (sup_eq_left.2 _),
    simpa [← ring_hom.ker_eq_comap_bot] using hIP},
end

/-- `comap (algebra_map R S)` is a surjection from the max spec of `S` to max spec of `R`.
`hP : (algebra_map R S).ker ≤ P` is a slight generalization of the extension being injective -/
lemma exists_ideal_over_maximal_of_is_integral (H : algebra.is_integral R S)
  (P : ideal R) [P_max : is_maximal P] (hP : (algebra_map R S).ker ≤ P) :
  ∃ (Q : ideal S), is_maximal Q ∧ Q.comap (algebra_map R S) = P :=
begin
  obtain ⟨Q, ⟨Q_prime, hQ⟩⟩ := exists_ideal_over_prime_of_is_integral' H P hP,
  haveI : Q.is_prime := Q_prime,
  exact ⟨Q, is_maximal_of_is_integral_of_is_maximal_comap H _ (hQ.symm ▸ P_max), hQ⟩,
end

end integral_domain

end ideal


theorem succ_succ_inj {a b : ℕ} (h : nat.succ(nat.succ(a)) = nat.succ(nat.succ(b))) :  a = b :=
begin
    have hs : nat.succ a = nat.succ b,
    apply nat.succ.inj h,
    apply nat.succ.inj hs,
end


-- Pruebas de P → (Q → P)
-- ======================

-- ----------------------------------------------------
-- Ej. 1. (p. 13) Demostrar
--    P → (Q → P)
-- ----------------------------------------------------

import tactic

variables (P Q : Prop)

-- 1ª demostración
example : P → (Q → P) :=
assume (h1 : P),
show Q → P, from
  ( assume h2 : Q,
    show P, from h1)

lemma ejemplo1 : P → (Q → P) :=
assume (h1 : P),
show Q → P, from
  ( assume h2 : Q,
    show P, from h1)

#print ejemplo1
-- Escribe
--    theorem ejemplo1 : ∀ (P Q : Prop), P → Q → P :=
--    λ (P Q : Prop) (h1 : P), show Q → P, from λ (h2 : Q), show P, from h1

-- 2ª demostración
example : P → (Q → P) :=
assume (h1 : P),
show Q → P, from
  ( assume h2 : Q, h1)

-- 3ª demostración
example : P → (Q → P) :=
assume (h1 : P),
show Q → P, from
  (λ h2, h1)

-- 4ª demostración
example : P → (Q → P) :=
assume (h1 : P), (λ h2, h1)

-- 5ª demostración
example : P → (Q → P) :=
λ h1, λ h2, h1

lemma ejemplo2 : P → (Q → P) :=
λ h1 h2, h1

#print ejemplo2
-- Escribe
--    theorem ejemplo2 : ∀ (P Q : Prop), P → Q → P :=
--    λ (P Q : Prop) (h1 : P) (h2 : Q), h1

-- 6ª demostración
example : P → (Q → P) :=
λ h1 h2, h1

-- 7ª demostración
example : P → (Q → P) :=
λ h _, h

-- 8ª demostración
example : P → (Q → P) :=
-- by library_search
imp_intro

-- 9ª demostración
example : P → (Q → P) :=
begin
  intro h1,
  intro h2,
  exact h1,
end

lemma ejemplo3 : P → (Q → P) :=
begin
  intro h1,
  intro h2,
  exact h1,
end

#print ejemplo3
-- Escribe
--    theorem ejemplo3 : ∀ (P Q : Prop), P → Q → P :=
--    λ (P Q : Prop) (h1 : P) (h2 : Q), h1

-- 10ª demostración
example : P → (Q → P) :=
begin
  intros h1 h2,
  exact h1,
end

-- 11ª demostración
example : P → (Q → P) :=
λ h1 h2, h1

-- 12ª demostración
example : P → (Q → P) :=
-- by hint
by tauto

lemma ejemplo4 : P → (Q → P) :=
by tauto

#print ejemplo4
-- Escribe
--    theorem ejemplo4 : ∀ (P Q : Prop), P → Q → P :=
--    λ (P Q : Prop) (a : P) (a_1 : Q), rfl.mpr a

-- 13ª demostración
example : P → (Q → P) :=
by finish

lemma ejemplo5 : P → (Q → P) :=
by finish

#print ejemplo5
-- Escribe
--    λ (P Q : Prop),
--      (id (eq.refl (P → Q → P))).mpr
--      (λ (a : P) (a_1 : Q), classical.by_contradiction (λ (a_2 : ¬P), absurd a a_2))


/-
Copyright (c) 2022 Yuyang Zhao. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yuyang Zhao
-/
import Std.Classes.Order
import Std.Logic

namespace Std.PairingHeapImp

/--
A `Heap` is the nodes of the pairing heap.
Each node have two pointers: `child` going to the first child of this node,
and `sibling` goes to the next sibling of this tree.
So it actually encodes a forest where each node has children
`node.child`, `node.child.sibling`, `node.child.sibling.sibling`, etc.

Each edge in this forest denotes a `le a b` relation that has been checked, so
the root is smaller than everything else under it.
-/
inductive Heap (α : Type u) where
  /-- An empty forest, which has depth `0`. -/
  | nil : Heap α
  /-- A forest consists of a root `a`, a forest `child` elements greater than `a`,
  and another forest `sibling`. -/
  | node (a : α) (child sibling : Heap α) : Heap α
  deriving Repr

/-- `O(n)`. The number of elements in the heap. -/
def Heap.size : Heap α → Nat
  | .nil => 0
  | .node _ c s => c.size + 1 + s.size

/-- A node containing a single element `a`. -/
def Heap.singleton (a : α) : Heap α := .node a .nil .nil

/-- `O(1)`. Is the heap empty? -/
def Heap.isEmpty : Heap α → Bool
  | .nil => true
  | _    => false

/-- `O(1)`. Merge two heaps. Ignore siblings. -/
@[specialize] def Heap.merge (le : α → α → Bool) : Heap α → Heap α → Heap α
  | .nil, .nil => .nil
  | .nil, .node a₂ c₂ _ => .node a₂ c₂ .nil
  | .node a₁ c₁ _, .nil => .node a₁ c₁ .nil
  | .node a₁ c₁ _, .node a₂ c₂ _ =>
    if le a₁ a₂ then .node a₁ (.node a₂ c₂ c₁) .nil else .node a₂ (.node a₁ c₁ c₂) .nil

/-- Auxiliary for `Heap.deleteMin`: merge the forest in pairs. -/
@[specialize] def Heap.combine (le : α → α → Bool) : Heap α → Heap α
  | h₁@(.node _ _ h₂@(.node _ _ s)) => merge le (merge le h₁ h₂) (s.combine le)
  | h => h

/-- `O(1)`. Get the smallest element in the heap, including the passed in value `a`. -/
@[inline] def Heap.headD (a : α) : Heap α → α
  | .nil => a
  | .node a _ _ => a

/-- `O(1)`. Get the smallest element in the heap, if it has an element. -/
@[inline] def Heap.head? : Heap α → Option α
  | .nil => none
  | .node a _ _ => some a

/-- Amortized `O(log n)`. Find and remove the the minimum element from the heap. -/
@[inline] def Heap.deleteMin (le : α → α → Bool) : Heap α → Option (α × Heap α)
  | .nil => none
  | .node a c _ => (a, combine le c)

/-- Amortized `O(log n)`. Get the tail of the pairing heap after removing the minimum element. -/
@[inline] def Heap.tail? (le : α → α → Bool) (h : Heap α) : Option (Heap α) :=
  deleteMin le h |>.map (·.snd)

/-- Amortized `O(log n)`. Remove the minimum element of the heap. -/
@[inline] def Heap.tail (le : α → α → Bool) (h : Heap α) : Heap α :=
  tail? le h |>.getD .nil

/-- A predicate says there is no more than one tree. -/
inductive Heap.NoSibling : Heap α → Prop
  /-- An empty heap is no more than one tree. -/
  | nil : NoSibling .nil
  /-- Or there is exactly one tree. -/
  | node (a c) : NoSibling (.node a c .nil)

instance : Decidable (Heap.NoSibling s) :=
  match s with
  | .nil => isTrue .nil
  | .node a c .nil => isTrue (.node a c)
  | .node _ _ (.node _ _ _) => isFalse fun.

theorem Heap.noSibling_merge (le) (s₁ s₂ : Heap α) :
    (s₁.merge le s₂).NoSibling := by
  unfold merge
  (split <;> try split) <;> constructor

theorem Heap.noSibling_combine (le) (s : Heap α) :
    (s.combine le).NoSibling := by
  unfold combine; split
  · exact noSibling_merge _ _ _
  · match s with
    | nil | node _ _ nil => constructor
    | node _ _ (node _ _ s) => rename_i h; exact (h _ _ _ _ _ rfl).elim

theorem Heap.noSibling_deleteMin {s : Heap α} (eq : s.deleteMin le = some (a, s')) :
    s'.NoSibling := by
  cases s with cases eq | node a c => exact noSibling_combine _ _

theorem Heap.noSibling_tail? {s : Heap α} : s.tail? le = some s' →
    s'.NoSibling := by
  simp only [Heap.tail?]; intro eq
  match eq₂ : s.deleteMin le, eq with
  | some (a, tl), rfl => exact noSibling_deleteMin eq₂

theorem Heap.noSibling_tail (le) (s : Heap α) : (s.tail le).NoSibling := by
  simp only [Heap.tail]
  match eq : s.tail? le with
  | none => cases s with cases eq | nil => constructor
  | some tl => exact Heap.noSibling_tail? eq

theorem Heap.size_merge (le) {s₁ s₂ : Heap α} (h₁ : s₁.NoSibling) (h₂ : s₂.NoSibling) :
    (merge le s₁ s₂).size = s₁.size + s₂.size := by
  match h₁, h₂ with
  | .nil, .nil | .nil, .node _ _ | .node _ _, .nil => simp [size]
  | .node _ _, .node _ _ => unfold merge; dsimp; split <;> simp_arith [size]

theorem Heap.size_combine (le) (s : Heap α) :
    (s.combine le).size = s.size := by
  unfold combine; split
  · rename_i a₁ c₁ a₂ c₂ s
    rw [size_merge le (noSibling_merge _ _ _) (noSibling_combine _ _),
      size_merge_node, size_combine le s]
    simp_arith [size]
  · rfl

theorem Heap.size_deleteMin {s : Heap α} (h : s.NoSibling) (eq : s.deleteMin le = some (a, s')) :
    s.size = s'.size + 1 := by
  cases h with cases eq | node a c => rw [size_combine, size, size]

theorem Heap.size_tail? {s : Heap α} (h : s.NoSibling) : s.tail? le = some s' →
    s.size = s'.size + 1 := by
  simp only [Heap.tail?]; intro eq
  match eq₂ : s.deleteMin le, eq with
  | some (a, tl), rfl => exact size_deleteMin h eq₂

theorem Heap.size_tail (le) {s : Heap α} (h : s.NoSibling) : (s.tail le).size = s.size - 1 := by
  simp only [Heap.tail]
  match eq : s.tail? le with
  | none => cases s with cases eq | nil => rfl
  | some tl => simp [Heap.size_tail? h eq]; rfl

theorem Heap.size_deleteMin_lt {s : Heap α} (eq : s.deleteMin le = some (a, s')) :
    s'.size < s.size := by
  cases s with cases eq | node a c => simp_arith [size_combine, size]

theorem Heap.size_tail?_lt {s : Heap α} : s.tail? le = some s' →
    s'.size < s.size := by
  simp only [Heap.tail?]; intro eq
  match eq₂ : s.deleteMin le, eq with
  | some (a, tl), rfl => exact size_deleteMin_lt eq₂

/--
`O(n log n)`. Monadic fold over the elements of a heap in increasing order,
by repeatedly pulling the minimum element out of the heap.
-/
@[specialize] def Heap.foldM [Monad m] (le : α → α → Bool) (s : Heap α)
    (init : β) (f : β → α → m β) : m β :=
  match eq : s.deleteMin le with
  | none => pure init
  | some (hd, tl) =>
    have : tl.size < s.size := by simp_arith [Heap.size_deleteMin_lt eq]
    do foldM le tl (← f init hd) f
termination_by _ => s.size

/--
`O(n log n)`. Fold over the elements of a heap in increasing order,
by repeatedly pulling the minimum element out of the heap.
-/
@[inline] def Heap.fold (le : α → α → Bool) (s : Heap α) (init : β) (f : β → α → β) : β :=
  Id.run <| s.foldM le init f

/-- `O(n log n)`. Convert the heap to an array in increasing order. -/
@[inline] def Heap.toArray (le : α → α → Bool) (s : Heap α) : Array α := fold le s #[] Array.push

/-- `O(n log n)`. Convert the heap to a list in increasing order. -/
@[inline] def Heap.toList (le : α → α → Bool) (s : Heap α) : List α := (s.toArray le).toList

/-- `O(n)`. Fold a monadic function over the tree structure to accumulate a value. -/
@[specialize] def Heap.foldTreeM [Monad m] (nil : β) (join : α → β → β → m β) : Heap α → m β
  | .nil => pure nil
  | .node a c s => do join a (← c.foldTreeM nil join) (← s.foldTreeM nil join)

/-- `O(n)`. Fold a function over the tree structure to accumulate a value. -/
@[inline] def Heap.foldTree (nil : β) (join : α → β → β → β) (s : Heap α) : β :=
  Id.run <| s.foldTreeM nil join

/-- `O(n)`. Convert the heap to a list in arbitrary order. -/
def Heap.toListUnordered (s : Heap α) : List α :=
  s.foldTree id (fun a c s l => a :: c (s l)) []

/-- `O(n)`. Convert the heap to an array in arbitrary order. -/
def Heap.toArrayUnordered (s : Heap α) : Array α :=
  s.foldTree id (fun a c s r => s (c (r.push a))) #[]

/--
The well formedness predicate for a heap node.
It asserts that:
* If `a` is added at the top to make the forest into a tree, the resulting tree
  is a `le`-min-heap (if `le` is well-behaved)
-/
def Heap.NodeWF (le : α → α → Bool) (a : α) : Heap α → Prop
  | .nil => True
  | .node b c s => (∀ [TotalBLE le], le a b) ∧ c.NodeWF le b ∧ s.NodeWF le a

/--
The well formedness predicate for a pairing heap.
It asserts that:
* There is no more than one tree.
* It is a `le`-min-heap (if `le` is well-behaved)
-/
inductive Heap.WF (le : α → α → Bool) : Heap α → Prop
  /-- It is an empty heap. -/
  | nil : WF le .nil
  /-- There is exactly one tree and it is a `le`-min-heap. -/
  | node (h : c.NodeWF le a) : WF le (.node a c .nil)

theorem Heap.WF.singleton : (Heap.singleton a).WF le := node trivial

theorem Heap.WF.merge_node (h₁ : NodeWF le a₁ c₁) (h₂ : NodeWF le a₂ c₂) :
    (merge le (.node a₁ c₁ s₁) (.node a₂ c₂ s₂)).WF le := by
  unfold merge; dsimp
  split <;> rename_i h
  · exact node ⟨fun [_] => h, h₂, h₁⟩
  · exact node ⟨fun [_] => TotalBLE.total.resolve_left h, h₁, h₂⟩

theorem Heap.WF.merge (h₁ : s₁.WF le) (h₂ : s₂.WF le) :
    (merge le s₁ s₂).WF le :=
  match h₁, h₂ with
  | .nil, .nil => nil
  | .nil, .node h₂ => node h₂
  | .node h₁, .nil => node h₁
  | .node h₁, .node h₂ => merge_node h₁ h₂

theorem Heap.WF.combine (h : s.NodeWF le a) : (combine le s).WF le :=
  match s with
  | .nil => nil
  | .node b c .nil => node h.2.1
  | .node b₁ c₁ (.node b₂ c₂ s) => merge (merge_node h.2.1 h.2.2.2.1) (combine h.2.2.2.2)

theorem Heap.WF.deleteMin {s : Heap α} (h : s.WF le)
    (eq : s.deleteMin le = some (a, s')) : s'.WF le := by
  cases h with cases eq | node h => exact Heap.WF.combine h

theorem Heap.WF.tail? (hwf : (s : Heap α).WF le) : s.tail? le = some tl →
  tl.WF le := by
  simp only [Heap.tail?]; intro eq
  match eq₂ : s.deleteMin le, eq with
  | some (a, tl), rfl => exact hwf.deleteMin eq₂

theorem Heap.WF.tail (hwf : (s : Heap α).WF le) : (s.tail le).WF le := by
  simp only [Heap.tail]
  match eq : s.tail? le with
  | none => exact Heap.WF.nil
  | some tl => exact hwf.tail? eq

theorem Heap.deleteMin_fst : ((s : Heap α).deleteMin le).map (·.1) = s.head? :=
  match s with
  | .nil => rfl
  | .node _ _ _ => rfl

end PairingHeapImp

open PairingHeapImp

/--
A [pairing heap](https://en.wikipedia.org/wiki/Pairing_heap) is a data structure which supports
the following primary operations:

* `insert : α → PairingHeap α → PairingHeap α`: add an element to the heap
* `deleteMin : PairingHeap α → Option (α × PairingHeap α)`:
  remove the minimum element from the heap
* `merge : PairingHeap α → PairingHeap α → PairingHeap α`: combine two heaps

The first two operations are known as a "priority queue", so this could be called
a "mergeable priority queue". The standard choice for a priority queue is a binary heap,
which supports `insert` and `deleteMin` in `O(log n)`, but `merge` is `O(n)`.
With a `PairingHeap`, `insert` and `merge` are `O(1)`, `deleteMin` is amortized `O(log n)`.

Note that `deleteMin` may be `O(n)` in a single operation. So if you need an efficient
persistent priority queue, you should use other data structures with better worst-case time.
-/
def PairingHeap (α : Type u) (le : α → α → Bool) :=
  { h : Heap α // h.WF le }

/-- `O(1)`. Make a new empty pairing heap. -/
@[inline] def mkPairingHeap (α : Type u) (le : α → α → Bool) : PairingHeap α le :=
  ⟨.nil, Heap.WF.nil⟩

namespace PairingHeap
variable {α : Type u} {le : α → α → Bool}

/-- `O(1)`. Make a new empty pairing heap. -/
@[inline] def empty : PairingHeap α le := mkPairingHeap α le

instance : Inhabited (PairingHeap α le) := ⟨.empty⟩

/-- `O(1)`. Is the heap empty? -/
@[inline] def isEmpty (b : PairingHeap α le) : Bool := b.1.isEmpty

/-- `O(n)`. The number of elements in the heap. -/
@[inline] def size (b : PairingHeap α le) : Nat := b.1.size

/-- `O(1)`. Make a new heap containing `a`. -/
@[inline] def singleton (a : α) : PairingHeap α le :=
  ⟨Heap.singleton a, Heap.WF.singleton⟩

/-- `O(1)`. Merge the contents of two heaps. -/
@[inline] def merge : PairingHeap α le → PairingHeap α le → PairingHeap α le
  | ⟨b₁, h₁⟩, ⟨b₂, h₂⟩ => ⟨b₁.merge le b₂, h₁.merge h₂⟩

/-- `O(1)`. Add element `a` to the given heap `h`. -/
@[inline] def insert (a : α) (h : PairingHeap α le) : PairingHeap α le :=
  merge (singleton a) h

/-- `O(n log n)`. Construct a heap from a list by inserting all the elements. -/
def ofList (le : α → α → Bool) (as : List α) : PairingHeap α le :=
  as.foldl (flip insert) empty

/-- `O(n log n)`. Construct a heap from a list by inserting all the elements. -/
def ofArray (le : α → α → Bool) (as : Array α) : PairingHeap α le :=
  as.foldl (flip insert) empty

/-- Amortized `O(log n)`. Remove and return the minimum element from the heap. -/
@[inline] def deleteMin (b : PairingHeap α le) : Option (α × PairingHeap α le) :=
  match eq : b.1.deleteMin le with
  | none => none
  | some (a, tl) => some (a, ⟨tl, b.2.deleteMin eq⟩)

/-- `O(1)`. Returns the smallest element in the heap, or `none` if the heap is empty. -/
@[inline] def head? (b : PairingHeap α le) : Option α := b.1.head?

/-- `O(1)`. Returns the smallest element in the heap, or panics if the heap is empty. -/
@[inline] def head! [Inhabited α] (b : PairingHeap α le) : α := b.head?.get!

/-- `O(1)`. Returns the smallest element in the heap, or `default` if the heap is empty. -/
@[inline] def headI [Inhabited α] (b : PairingHeap α le) : α := b.head?.getD default

/--
Amortized `O(log n)`. Removes the smallest element from the heap, or `none` if the heap is empty.
-/
@[inline] def tail? (b : PairingHeap α le) : Option (PairingHeap α le) :=
  match eq : b.1.tail? le with
  | none => none
  | some tl => some ⟨tl, b.2.tail? eq⟩

/-- Amortized `O(log n)`. Removes the smallest element from the heap, if possible. -/
@[inline] def tail (b : PairingHeap α le) : PairingHeap α le := ⟨b.1.tail le, b.2.tail⟩

/-- `O(n log n)`. Convert the heap to a list in increasing order. -/
@[inline] def toList (b : PairingHeap α le) : List α := b.1.toList le

/-- `O(n log n)`. Convert the heap to an array in increasing order. -/
@[inline] def toArray (b : PairingHeap α le) : Array α := b.1.toArray le

/-- `O(n)`. Convert the heap to a list in arbitrary order. -/
@[inline] def toListUnordered (b : PairingHeap α le) : List α := b.1.toListUnordered

/-- `O(n)`. Convert the heap to an array in arbitrary order. -/
@[inline] def toArrayUnordered (b : PairingHeap α le) : Array α := b.1.toArrayUnordered


/-
Copyright (c) 2019 Amelia Livingston. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Amelia Livingston, Bryan Gin-ge Chen
-/
import order.galois_connection

/-!
# Equivalence relations

This file defines the complete lattice of equivalence relations on a type, results about the
inductively defined equivalence closure of a binary relation, and the analogues of some isomorphism
theorems for quotients of arbitrary types.

## Implementation notes

The function `rel` and lemmas ending in ' make it easier to talk about different
equivalence relations on the same type.

The complete lattice instance for equivalence relations could have been defined by lifting
the Galois insertion of equivalence relations on α into binary relations on α, and then using
`complete_lattice.copy` to define a complete lattice instance with more appropriate
definitional equalities (a similar example is `filter.complete_lattice` in
`order/filter/basic.lean`). This does not save space, however, and is less clear.

Partitions are not defined as a separate structure here; users are encouraged to
reason about them using the existing `setoid` and its infrastructure.

## Tags

setoid, equivalence, iseqv, relation, equivalence relation
-/
variables {α : Type*} {β : Type*}

/-- A version of `setoid.r` that takes the equivalence relation as an explicit argument. -/
def setoid.rel (r : setoid α) : α → α → Prop := @setoid.r _ r

/-- A version of `quotient.eq'` compatible with `setoid.rel`, to make rewriting possible. -/
lemma quotient.eq_rel {r : setoid α} {x y} : ⟦x⟧ = ⟦y⟧ ↔ r.rel x y := quotient.eq'

namespace setoid

@[ext] lemma ext' {r s : setoid α} (H : ∀ a b, r.rel a b ↔ s.rel a b) :
  r = s := ext H

lemma ext_iff {r s : setoid α} : r = s ↔ ∀ a b, r.rel a b ↔ s.rel a b :=
⟨λ h a b, h ▸ iff.rfl, ext'⟩

/-- Two equivalence relations are equal iff their underlying binary operations are equal. -/
theorem eq_iff_rel_eq {r₁ r₂ : setoid α} : r₁ = r₂ ↔ r₁.rel = r₂.rel :=
⟨λ h, h ▸ rfl, λ h, setoid.ext' $ λ x y, h ▸ iff.rfl⟩

/-- Defining `≤` for equivalence relations. -/
instance : has_le (setoid α) := ⟨λ r s, ∀ ⦃x y⦄, r.rel x y → s.rel x y⟩

theorem le_def {r s : setoid α} : r ≤ s ↔ ∀ {x y}, r.rel x y → s.rel x y := iff.rfl

@[refl] lemma refl' (r : setoid α) (x) : r.rel x x := r.2.1 x
@[symm] lemma symm' (r : setoid α) : ∀ {x y}, r.rel x y → r.rel y x := λ _ _ h, r.2.2.1 h
@[trans]

/-- The kernel of a function is an equivalence relation. -/
def ker (f : α → β) : setoid α :=
⟨λ x y, f x = f y, ⟨λ _, rfl, λ _ _ h, h.symm, λ _ _ _ h, h.trans⟩⟩

/-- The kernel of the quotient map induced by an equivalence relation r equals r. -/
@[simp] lemma ker_mk_eq (r : setoid α) : ker (@quotient.mk _ r) = r :=
ext' $ λ x y, quotient.eq

lemma ker_def {f : α → β} {x y : α} : (ker f).rel x y ↔ f x = f y := iff.rfl

/-- Given types `α`, `β`, the product of two equivalence relations `r` on `α` and `s` on `β`:
    `(x₁, x₂), (y₁, y₂) ∈ α × β` are related by `r.prod s` iff `x₁` is related to `y₁`
    by `r` and `x₂` is related to `y₂` by `s`. -/
protected def prod (r : setoid α) (s : setoid β) : setoid (α × β) :=
{ r := λ x y, r.rel x.1 y.1 ∧ s.rel x.2 y.2,
  iseqv := ⟨λ x, ⟨r.refl' x.1, s.refl' x.2⟩, λ _ _ h, ⟨r.symm' h.1, s.symm' h.2⟩,
            λ _ _ _ h1 h2, ⟨r.trans' h1.1 h2.1, s.trans' h1.2 h2.2⟩⟩ }

/-- The infimum of two equivalence relations. -/
instance : has_inf (setoid α) :=
⟨λ r s, ⟨λ x y, r.rel x y ∧ s.rel x y, ⟨λ x, ⟨r.refl' x, s.refl' x⟩,
 λ _ _ h, ⟨r.symm' h.1, s.symm' h.2⟩,
 λ _ _ _ h1 h2, ⟨r.trans' h1.1 h2.1, s.trans' h1.2 h2.2⟩⟩⟩⟩

/-- The infimum of 2 equivalence relations r and s is the same relation as the infimum
    of the underlying binary operations. -/
lemma inf_def {r s : setoid α} : (r ⊓ s).rel = r.rel ⊓ s.rel := rfl

theorem inf_iff_and {r s : setoid α} {x y} :
  (r ⊓ s).rel x y ↔ r.rel x y ∧ s.rel x y := iff.rfl

/-- The infimum of a set of equivalence relations. -/
instance : has_Inf (setoid α) :=
⟨λ S, ⟨λ x y, ∀ r ∈ S, rel r x y,
⟨λ x r hr, r.refl' x, λ _ _ h r hr, r.symm' $ h r hr,
 λ _ _ _ h1 h2 r hr, r.trans' (h1 r hr) $ h2 r hr⟩⟩⟩

/-- The underlying binary operation of the infimum of a set of equivalence relations
    is the infimum of the set's image under the map to the underlying binary operation. -/
theorem Inf_def {s : set (setoid α)} : (Inf s).rel = Inf (rel '' s) :=
by { ext, simp only [Inf_image, infi_apply, infi_Prop_eq], refl }

instance : partial_order (setoid α) :=
{ le := (≤),
  lt := λ r s, r ≤ s ∧ ¬s ≤ r,
  le_refl := λ _ _ _, id,
  le_trans := λ _ _ _ hr hs _ _ h, hs $ hr h,
  lt_iff_le_not_le := λ _ _, iff.rfl,
  le_antisymm := λ r s h1 h2, setoid.ext' $ λ x y, ⟨λ h, h1 h, λ h, h2 h⟩ }

/-- The complete lattice of equivalence relations on a type, with bottom element `=`
    and top element the trivial equivalence relation. -/
instance complete_lattice : complete_lattice (setoid α) :=
{ inf := has_inf.inf,
  inf_le_left := λ _ _ _ _ h, h.1,
  inf_le_right := λ _ _ _ _ h, h.2,
  le_inf := λ _ _ _ h1 h2 _ _ h, ⟨h1 h, h2 h⟩,
  top := ⟨λ _ _, true, ⟨λ _, trivial, λ _ _ h, h, λ _ _ _ h1 h2, h1⟩⟩,
  le_top := λ _ _ _ _, trivial,
  bot := ⟨(=), ⟨λ _, rfl, λ _ _ h, h.symm, λ _ _ _ h1 h2, h1.trans h2⟩⟩,
  bot_le := λ r x y h, h ▸ r.2.1 x,
  .. complete_lattice_of_Inf (setoid α) $ assume s,
    ⟨λ r hr x y h, h _ hr, λ r hr x y h r' hr', hr hr' h⟩ }

/-- The inductively defined equivalence closure of a binary relation r is the infimum
    of the set of all equivalence relations containing r. -/
theorem eqv_gen_eq (r : α → α → Prop) :
  eqv_gen.setoid r = Inf {s : setoid α | ∀ ⦃x y⦄, r x y → s.rel x y} :=
le_antisymm
  (λ _ _ H, eqv_gen.rec (λ _ _ h _ hs, hs h) (refl' _)
    (λ _ _ _, symm' _) (λ _ _ _ _ _, trans' _) H)
  (Inf_le $ λ _ _ h, eqv_gen.rel _ _ h)

/-- The supremum of two equivalence relations r and s is the equivalence closure of the binary
    relation `x is related to y by r or s`. -/
lemma sup_eq_eqv_gen (r s : setoid α) :
  r ⊔ s = eqv_gen.setoid (λ x y, r.rel x y ∨ s.rel x y) :=
begin
  rw eqv_gen_eq,
  apply congr_arg Inf,
  simp only [le_def, or_imp_distrib, ← forall_and_distrib]
end

/-- The supremum of 2 equivalence relations r and s is the equivalence closure of the
    supremum of the underlying binary operations. -/
lemma sup_def {r s : setoid α} : r ⊔ s = eqv_gen.setoid (r.rel ⊔ s.rel) :=
by rw sup_eq_eqv_gen; refl

/-- The supremum of a set S of equivalence relations is the equivalence closure of the binary
    relation `there exists r ∈ S relating x and y`. -/
lemma Sup_eq_eqv_gen (S : set (setoid α)) :
  Sup S = eqv_gen.setoid (λ x y, ∃ r : setoid α, r ∈ S ∧ r.rel x y) :=
begin
  rw eqv_gen_eq,
  apply congr_arg Inf,
  simp only [upper_bounds, le_def, and_imp, exists_imp_distrib],
  ext,
  exact ⟨λ H x y r hr, H hr, λ H r hr x y, H r hr⟩
end

/-- The supremum of a set of equivalence relations is the equivalence closure of the
    supremum of the set's image under the map to the underlying binary operation. -/
lemma Sup_def {s : set (setoid α)} : Sup s = eqv_gen.setoid (Sup (rel '' s)) :=
begin
  rw [Sup_eq_eqv_gen, Sup_image],
  congr' with x y,
  simp only [supr_apply, supr_Prop_eq, exists_prop]
end

/-- The equivalence closure of an equivalence relation r is r. -/
@[simp] lemma eqv_gen_of_setoid (r : setoid α) : eqv_gen.setoid r.r = r :=
le_antisymm (by rw eqv_gen_eq; exact Inf_le (λ _ _, id)) eqv_gen.rel

/-- Equivalence closure is idempotent. -/
@[simp] lemma eqv_gen_idem (r : α → α → Prop) :
  eqv_gen.setoid (eqv_gen.setoid r).rel = eqv_gen.setoid r :=
eqv_gen_of_setoid _

/-- The equivalence closure of a binary relation r is contained in any equivalence
    relation containing r. -/
theorem eqv_gen_le {r : α → α → Prop} {s : setoid α} (h : ∀ x y, r x y → s.rel x y) :
  eqv_gen.setoid r ≤ s :=
by rw eqv_gen_eq; exact Inf_le h

/-- Equivalence closure of binary relations is monotonic. -/
theorem eqv_gen_mono {r s : α → α → Prop} (h : ∀ x y, r x y → s x y) :
  eqv_gen.setoid r ≤ eqv_gen.setoid s :=
eqv_gen_le $ λ _ _ hr, eqv_gen.rel _ _ $ h _ _ hr

/-- There is a Galois insertion of equivalence relations on α into binary relations
    on α, with equivalence closure the lower adjoint. -/
def gi : @galois_insertion (α → α → Prop) (setoid α) _ _ eqv_gen.setoid rel :=
{ choice := λ r h, eqv_gen.setoid r,
  gc := λ r s, ⟨λ H _ _ h, H $ eqv_gen.rel _ _ h, λ H, eqv_gen_of_setoid s ▸ eqv_gen_mono H⟩,
  le_l_u := λ x, (eqv_gen_of_setoid x).symm ▸ le_refl x,
  choice_eq := λ _ _, rfl }

open function

/-- A function from α to β is injective iff its kernel is the bottom element of the complete lattice
    of equivalence relations on α. -/
theorem injective_iff_ker_bot (f : α → β) :
  injective f ↔ ker f = ⊥ :=
(@eq_bot_iff (setoid α) _ (ker f)).symm

/-- The elements related to x ∈ α by the kernel of f are those in the preimage of f(x) under f. -/
lemma ker_iff_mem_preimage {f : α → β} {x y} : (ker f).rel x y ↔ x ∈ f ⁻¹' {f y} :=
iff.rfl

/-- Equivalence between functions `α → β` such that `r x y → f x = f y` and functions
`quotient r → β`. -/
def lift_equiv (r : setoid α) : {f : α → β // r ≤ ker f} ≃ (quotient r → β) :=
{ to_fun := λ f, quotient.lift (f : α → β) f.2,
  inv_fun := λ f, ⟨f ∘ quotient.mk, λ x y h, by simp [ker_def, quotient.sound h]⟩,
  left_inv := λ ⟨f, hf⟩, subtype.eq $ funext $ λ x, rfl,
  right_inv := λ f, funext $ λ x, quotient.induction_on' x $ λ x, rfl }

/-- The uniqueness part of the universal property for quotients of an arbitrary type. -/
theorem lift_unique {r : setoid α} {f : α → β} (H : r ≤ ker f) (g : quotient r → β)
  (Hg : f = g ∘ quotient.mk) : quotient.lift f H = g :=
begin
  ext ⟨x⟩,
  erw [quotient.lift_mk f H, Hg],
  refl
end

/-- Given a map f from α to β, the natural map from the quotient of α by the kernel of f is
    injective. -/
lemma ker_lift_injective (f : α → β) : injective (@quotient.lift _ _ (ker f) f (λ _ _ h, h)) :=
λ x y, quotient.induction_on₂' x y $ λ a b h, quotient.sound' h

/-- Given a map f from α to β, the kernel of f is the unique equivalence relation on α whose
    induced map from the quotient of α to β is injective. -/
lemma ker_eq_lift_of_injective {r : setoid α} (f : α → β) (H : ∀ x y, r.rel x y → f x = f y)
  (h : injective (quotient.lift f H)) : ker f = r :=
le_antisymm
  (λ x y hk, quotient.exact $ h $ show quotient.lift f H ⟦x⟧ = quotient.lift f H ⟦y⟧, from hk)
  H

variables (r : setoid α) (f : α → β)

/-- The first isomorphism theorem for sets: the quotient of α by the kernel of a function f
    bijects with f's image. -/
noncomputable def quotient_ker_equiv_range :
  quotient (ker f) ≃ set.range f :=
equiv.of_bijective (@quotient.lift _ (set.range f) (ker f)
  (λ x, ⟨f x, set.mem_range_self x⟩) $ λ _ _ h, subtype.ext_val h)
  ⟨λ x y h, ker_lift_injective f $ by rcases x; rcases y; injections,
   λ ⟨w, z, hz⟩, ⟨@quotient.mk _ (ker f) z, by rw quotient.lift_mk; exact subtype.ext_iff_val.2 hz⟩⟩

/-- The quotient of α by the kernel of a surjective function f bijects with f's codomain. -/
noncomputable def quotient_ker_equiv_of_surjective (hf : surjective f) :
  quotient (ker f) ≃ β :=
(quotient_ker_equiv_range f).trans $ equiv.subtype_univ_equiv hf

variables {r f}

/-- Given a function `f : α → β` and equivalence relation `r` on `α`, the equivalence
    closure of the relation on `f`'s image defined by '`x ≈ y` iff the elements of `f⁻¹(x)` are
    related to the elements of `f⁻¹(y)` by `r`.' -/
def map (r : setoid α) (f : α → β) : setoid β :=
eqv_gen.setoid $ λ x y, ∃ a b, f a = x ∧ f b = y ∧ r.rel a b

/-- Given a surjective function f whose kernel is contained in an equivalence relation r, the
    equivalence relation on f's codomain defined by x ≈ y ↔ the elements of f⁻¹(x) are related to
    the elements of f⁻¹(y) by r. -/
def map_of_surjective (r) (f : α → β) (h : ker f ≤ r) (hf : surjective f) :
  setoid β :=
⟨λ x y, ∃ a b, f a = x ∧ f b = y ∧ r.rel a b,
  ⟨λ x, let ⟨y, hy⟩ := hf x in ⟨y, y, hy, hy, r.refl' y⟩,
   λ _ _ ⟨x, y, hx, hy, h⟩, ⟨y, x, hy, hx, r.symm' h⟩,
   λ _ _ _ ⟨x, y, hx, hy, h₁⟩ ⟨y', z, hy', hz, h₂⟩,
     ⟨x, z, hx, hz, r.trans' h₁ $ r.trans' (h $ by rwa ←hy' at hy) h₂⟩⟩⟩

/-- A special case of the equivalence closure of an equivalence relation r equalling r. -/
lemma map_of_surjective_eq_map (h : ker f ≤ r) (hf : surjective f) :
  map r f = map_of_surjective r f h hf :=
by rw ←eqv_gen_of_setoid (map_of_surjective r f h hf); refl

/-- Given a function `f : α → β`, an equivalence relation `r` on `β` induces an equivalence
    relation on `α` defined by '`x ≈ y` iff `f(x)` is related to `f(y)` by `r`'. -/
def comap (f : α → β) (r : setoid β) : setoid α :=
⟨λ x y, r.rel (f x) (f y), ⟨λ _, r.refl' _, λ _ _ h, r.symm' h, λ _ _ _ h1, r.trans' h1⟩⟩

/-- Given a map `f : N → M` and an equivalence relation `r` on `β`, the equivalence relation
    induced on `α` by `f` equals the kernel of `r`'s quotient map composed with `f`. -/
lemma comap_eq {f : α → β} {r : setoid β} : comap f r = ker (@quotient.mk _ r ∘ f) :=
ext $ λ x y, show _ ↔ ⟦_⟧ = ⟦_⟧, by rw quotient.eq; refl

/-- The second isomorphism theorem for sets. -/
noncomputable def comap_quotient_equiv (f : α → β) (r : setoid β) :
  quotient (comap f r) ≃ set.range (@quotient.mk _ r ∘ f) :=
(quotient.congr_right $ ext_iff.1 comap_eq).trans $ quotient_ker_equiv_range $ quotient.mk ∘ f

variables (r f)

/-- The third isomorphism theorem for sets. -/
def quotient_quotient_equiv_quotient (s : setoid α) (h : r ≤ s) :
  quotient (ker (quot.map_right h)) ≃ quotient s :=
{ to_fun := λ x, quotient.lift_on' x (λ w, quotient.lift_on' w (@quotient.mk _ s) $
    λ x y H, quotient.sound $ h H) $ λ x y, quotient.induction_on₂' x y $ λ w z H,
      show @quot.mk _ _ _ = @quot.mk _ _ _, from H,
  inv_fun := λ x, quotient.lift_on' x
    (λ w, @quotient.mk _ (ker $ quot.map_right h) $ @quotient.mk _ r w) $
      λ x y H, quotient.sound' $ show @quot.mk _ _ _ = @quot.mk _ _ _, from quotient.sound H,
  left_inv := λ x, quotient.induction_on' x $ λ y, quotient.induction_on' y $
    λ w, by show ⟦_⟧ = _; refl,
  right_inv := λ x, quotient.induction_on' x $ λ y, by show ⟦_⟧ = _; refl }

variables {r f}

open quotient

/-- Given an equivalence relation `r` on `α`, the order-preserving bijection between the set of
equivalence relations containing `r` and the equivalence relations on the quotient of `α` by `r`. -/
def correspondence (r : setoid α) : {s // r ≤ s} ≃o setoid (quotient r) :=
{ to_fun := λ s, map_of_surjective s.1 quotient.mk ((ker_mk_eq r).symm ▸ s.2) exists_rep,
  inv_fun := λ s, ⟨comap quotient.mk s, λ x y h, show s.rel ⟦x⟧ ⟦y⟧, by rw eq_rel.2 h⟩,
  left_inv := λ s, subtype.ext_iff_val.2 $ ext' $ λ _ _,
    ⟨λ h, let ⟨a, b, hx, hy, H⟩ := h in
      s.1.trans' (s.1.symm' $ s.2 $ eq_rel.1 hx) $ s.1.trans' H $ s.2 $ eq_rel.1 hy,
     λ h, ⟨_, _, rfl, rfl, h⟩⟩,
  right_inv := λ s, let Hm : ker quotient.mk ≤ comap quotient.mk s :=
      λ x y h, show s.rel ⟦x⟧ ⟦y⟧, by rw (@eq_rel _ r x y).2 ((ker_mk_eq r) ▸ h) in
    ext' $ λ x y, ⟨λ h, let ⟨a, b, hx, hy, H⟩ := h in hx ▸ hy ▸ H,
      quotient.induction_on₂ x y $ λ w z h, ⟨w, z, rfl, rfl, h⟩⟩,
  map_rel_iff' := λ s t, ⟨λ h x y hs, let ⟨a, b, hx, hy, ht⟩ := h ⟨x, y, rfl, rfl, hs⟩ in
      t.1.trans' (t.1.symm' $ t.2 $ eq_rel.1 hx) $ t.1.trans' ht $ t.2 $ eq_rel.1 hy,
      λ h x y hs, let ⟨a, b, hx, hy, Hs⟩ := hs in ⟨a, b, hx, hy, h Hs⟩⟩ }

end setoid


import tactic -- imports all the Lean tactics
import linear_algebra.basis
import data.real.basic
import data.complex.basic
import data.complex.module
import data.matrix.notation

variables (k : Type) (V : Type) [field k] [add_comm_group V] [module k V]

lemma matrix.fin_tail_cons (α : Type) (n : ℕ) (w : α) (v : fin n → α) : fin.tail (matrix.vec_cons w v) = v :=
begin
  nth_rewrite 1 ← @fin.tail_cons _ (λ_,α) w v,
  refl,
end

namespace exercise2A1

open submodule

lemma mem_pair_left {α : Type} {a b : α} {S : set α} (h : {a, b} ⊆ S) : a ∈ S := begin
  have ha : a ∈ {a,b} := set.mem_insert a {b},
  exact h ha,
end

lemma mem_pair_right {α : Type} {a b : α} {S : set α} (h : {a, b} ⊆ S) : b ∈ S := begin
  have hb : b ∈ {a,b},
    apply set.mem_insert_of_mem,
    exact set.mem_singleton b,
  exact h hb,
end

example (k : Type) (V : Type) [field k] [add_comm_group V] [module k V] (v1 v2 : V) : span k ({v1, v2} : set V) = span k ({v1-v2, v2} : set V) :=
begin
  ext,
  unfold span,
  split,
  simp only [set.mem_set_of_eq, mem_Inf],
  intros h p hp,
    apply h,
    intro v,
    intro hv,
    cases hv with h1 h2,
      rw h1,
      have k1 : (v1-v2) ∈ ↑p,
        exact mem_pair_left hp,
      have k2 : v2 ∈ ↑p,
        exact mem_pair_right hp,
      have k3 : (v1 - v2) + v2 = v1,
        simp only [sub_add_cancel],
      rw ← k3,
      exact p.add_mem k1 k2,

      rw set.mem_singleton_iff at h2,
      rw h2,
      exact mem_pair_right hp,

  simp only [set.mem_set_of_eq, mem_Inf],
  intros h p hp,
    apply h,
    intro v,
    intro hv,
    cases hv with h1 h2,
      rw h1,
      have k1 : v1 ∈ ↑p,
        exact mem_pair_left hp,
      have k2 : v2 ∈ ↑p,
        exact mem_pair_right hp,
      exact p.sub_mem k1 k2,

      rw set.mem_singleton_iff at h2,
      rw h2,
      exact mem_pair_right hp,
end

end exercise2A1

-- Exercise 2.A.3

namespace exercise2A3
-- approach 1
example : ∃ t a b c : ℝ, a • ((3,1,4) : ℝ × ℝ × ℝ) + b • (2,-3,5) + c • (5,9,t) = (0,0,0) ∧ (a,b,c) ≠ (0,0,0) :=
begin
  refine ⟨2, 3, -2, -1, _, by simp⟩,
  simp, split, ring, split, ring, ring,
end

--approach 2 (credit goes to Alex Best)
def ind' (t : ℝ) :=
![![3,1,4], ![2,-3,5], ![5,9,t]]

example : ∃ t : ℝ, ¬ linear_independent ℝ (ind' t) :=
begin
  unfold ind',
  use 2,
  rw fintype.not_linear_independent_iff,
  use ![3, -2, -1],
  split,
  norm_num [fin.sum_univ_succ, ind'],
  use 0,
  norm_num,
end

end exercise2A3

namespace exercise2A5
open complex

example : linear_independent ℝ ![1+I, 1-I] :=
begin
  rw fintype.linear_independent_iff,
  intros g h i,
  simp [fin.sum_univ_succ, ext_iff] at h,
  have h1: g 0 + g 1 + (g 0 + - g 1) = 0+0,
    exact congr (congr_arg has_add.add h.left) h.right,
  have h2: g 0 + g 1 - (g 0 + - g 1) = 0-0,
    exact congr (congr_arg has_sub.sub h.left) h.right,
  ring_nf at h1,
  ring_nf at h2,
  fin_cases i,
  linarith,
  linarith,
end

example : ¬ linear_independent ℂ ![1+I, 1-I] :=
begin
  rw fintype.not_linear_independent_iff,
  use ![-1,I],
  split,
  norm_num [fin.sum_univ_succ],
  ring_nf,
  simp only [I_sq, neg_neg, sub_self],
  use 0,
  simp only [matrix.cons_val_zero, ne.def, neg_eq_zero, one_ne_zero, not_false_iff],
end

end exercise2A5

namespace exercise2A6

example (v1 v2 v3 v4: V) (lin_indep : linear_independent k ![v1, v2, v3, v4]) : linear_independent k ![v1-v2, v2-v3, v3-v4, v4] :=
begin
  rw fintype.linear_independent_iff at *,
  intros g h,
  let f := ![g 0, g 1 - g 0, g 2 - g 1, g 3 - g 2],
  specialize lin_indep f,
  suffices  hf : ∀ (i : fin 4), f i = 0,
  have g0 : g 0 = 0,
    calc g 0 = f 0 : rfl
        ...  = 0 : hf 0,
  have g1 : g 1 = 0,
    calc g 1 = g 1 - g 0 + g 0 : by ring
      ... = f 1 + g 0 : by refl
      ... = 0 : by rw [hf 1, g0, zero_add],
  have g2 : g 2 = 0,
    calc g 2 = g 2 - g 1 + g 1 : by ring
      ... = f 2 + g 1 : by refl
      ... = 0 : by rw [hf 2, g1, zero_add],
  have g3 : g 3 = 0,
    calc g 3 = g 3 - g 2 + g 2 : by ring
      ... = f 3 + g 2 : by refl
      ... = 0 : by rw [hf 3, g2, zero_add],

  intro i,
  fin_cases i,
  exact g0,
  exact g1,
  exact g2,
  exact g3,

  apply lin_indep,
  calc finset.univ.sum (λ (i : fin 4), f i • ![v1, v2, v3, v4] i)
            = f 0 • v1 + f 1 • v2 + f 2 • v3 + f 3 • v4 : by
            begin
              simp only [fin.sum_univ_succ, add_assoc, matrix.cons_val_zero, matrix.cons_val_succ, fin.succ_zero_eq_one, fin.succ_one_eq_two, fintype.univ_of_subsingleton, fin.mk_eq_subtype_mk, fin.mk_zero, finset.sum_singleton, add_right_inj],
              refl,
            end
     ...    = g 0 • v1 + (g 1 - g 0) • v2 + (g 2 - g 1) • v3 + (g 3 - g 2) • v4 : rfl
     ...    = g 0 • (v1 - v2) + g 1 • (v2 - v3) + g 2 • (v3 - v4) + g 3 • v4 : by
            begin
              simp only [smul_sub, sub_smul],
              abel,
            end
     ...    = finset.univ.sum (λ (i : fin 4), g i • ![v1 - v2, v2 - v3, v3 - v4, v4] i) : by
            begin
              simp only [fin.sum_univ_succ, add_assoc, matrix.cons_val_zero, matrix.cons_val_succ, fin.succ_zero_eq_one, fin.succ_one_eq_two, fintype.univ_of_subsingleton, fin.mk_eq_subtype_mk, fin.mk_zero, finset.sum_singleton, add_right_inj],
              refl,
            end
     ...    = 0 : h,
end

end exercise2A6

namespace exercise2A8

example (m : ℕ) (v : fin m → V) (lin_indep : linear_independent k v) (a : k) : a ≠ 0 → linear_independent k (λ i, (a : k) • v i) :=
begin
  rw fintype.linear_independent_iff at *,
  intros ha g h,
  specialize lin_indep (λ i, g i • a),
  simp only [←smul_smul, ha, algebra.id.smul_eq_mul, mul_eq_zero, or_false] at lin_indep,
  exact lin_indep h,
end

end exercise2A8

namespace exercise2A9

example (v w : V) (hw : w = -v) (hv : v ≠ (0:V)) : linear_independent k ![v] ∧ linear_independent k ![w] ∧ ¬ linear_independent k ![v+w] :=
begin
  split,
  simp only [linear_independent_unique, hv, matrix.cons_val_fin_one, ne.def, not_false_iff],
  split,
  rw hw,
  simp only [linear_independent_unique, hv, matrix.cons_val_fin_one, ne.def, neg_eq_zero, not_false_iff],
  rw [hw, add_right_neg],
  simp only [linear_independent_unique_iff, matrix.cons_val_fin_one, ne.def, eq_self_iff_true, not_true, not_false_iff],
end

end exercise2A9

namespace exercise2A10

example (m : ℕ) (v : fin m → V) (lin_indep : linear_independent k v) (w : V) (not_lin_indep : ¬ linear_independent k (v+(λ _, w))) : w ∈ submodule.span k (set.range v) :=
begin
  rw fintype.not_linear_independent_iff at not_lin_indep,
  cases not_lin_indep with g hg,
  simp only [pi.add_apply, smul_add, ne.def, finset.sum_add_distrib, ← finset.sum_smul] at hg,
  let G : k := finset.univ.sum g, -- TODO
  -- have G ≠ 0,

  sorry,
end

end exercise2A10

namespace exercise2A11
-- Exercise 2.A.11

example (n : ℕ) (v : fin n → V) (lin_indep : linear_independent k v) (w : V) : linear_independent k (matrix.vec_cons w v) ↔ w ∉ submodule.span k (set.range v)
:=
begin
  rw linear_independent_fin_succ,
  simp only [matrix.fin_tail_cons, lin_indep, matrix.cons_val_zero, true_and],
end

end exercise2A11


/-
Copyright (c) 2019 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Patrick Massot, Casper Putz, Anne Baanen
-/
import data.matrix.block
import linear_algebra.matrix.finite_dimensional
import linear_algebra.std_basis
import ring_theory.algebra_tower
import algebra.module.algebra

/-!
# Linear maps and matrices

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

## Main definitions

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

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

## Issues

This file was originally written without attention to non-commutative rings,
and so mostly only works in the commutative setting. This should be fixed.

In particular, `matrix.mul_vec` gives us a linear equivalence
`matrix m n R ≃ₗ[R] (n → R) →ₗ[Rᵐᵒᵖ] (m → R)`
while `matrix.vec_mul` gives us a linear equivalence
`matrix m n R ≃ₗ[Rᵐᵒᵖ] (m → R) →ₗ[R] (n → R)`.
At present, the first equivalence is developed in detail but only for commutative rings
(and we omit the distinction between `Rᵐᵒᵖ` and `R`),
while the second equivalence is developed only in brief, but for not-necessarily-commutative rings.

Naming is slightly inconsistent between the two developments.
In the original (commutative) development `linear` is abbreviated to `lin`,
although this is not consistent with the rest of mathlib.
In the new (non-commutative) development `linear` is not abbreviated, and declarations use `_right`
to indicate they use the right action of matrices on vectors (via `matrix.vec_mul`).
When the two developments are made uniform, the names should be made uniform, too,
by choosing between `linear` and `lin` consistently,
and (presumably) adding `_left` where necessary.

## Tags

linear_map, matrix, linear_equiv, diagonal, det, trace
-/

noncomputable theory

open linear_map matrix set submodule
open_locale big_operators
open_locale matrix

universes u v w

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

section to_matrix_right

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

/-- `matrix.vec_mul M` is a linear map. -/
@[simps] def matrix.vec_mul_linear [fintype m] (M : matrix m n R) : (m → R) →ₗ[R] (n → R) :=
{ to_fun := λ x, M.vec_mul x,
  map_add' := λ v w, funext (λ i, add_dot_product _ _ _),
  map_smul' := λ c v, funext (λ i, smul_dot_product _ _ _) }

variables [fintype m] [decidable_eq m]

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

/--
Linear maps `(m → R) →ₗ[R] (n → R)` are linearly equivalent over `Rᵐᵒᵖ` to `matrix m n R`,
by having matrices act by right multiplication.
 -/
def linear_map.to_matrix_right' : ((m → R) →ₗ[R] (n → R)) ≃ₗ[Rᵐᵒᵖ] matrix m n R :=
{ to_fun := λ f i j, f (std_basis R (λ _, R) i 1) j,
  inv_fun := matrix.vec_mul_linear,
  right_inv := λ M, by
  { ext i j, simp only [matrix.vec_mul_std_basis, matrix.vec_mul_linear_apply] },
  left_inv := λ f, begin
    apply (pi.basis_fun R m).ext,
    intro j, ext i,
    simp only [pi.basis_fun_apply, matrix.vec_mul_std_basis, matrix.vec_mul_linear_apply]
  end,
  map_add' := λ f g, by { ext i j, simp only [pi.add_apply, linear_map.add_apply] },
  map_smul' := λ c f, by { ext i j, simp only [pi.smul_apply, linear_map.smul_apply,
                                               ring_hom.id_apply] } }

/-- A `matrix m n R` is linearly equivalent over `Rᵐᵒᵖ` to a linear map `(m → R) →ₗ[R] (n → R)`,
by having matrices act by right multiplication. -/
abbreviation matrix.to_linear_map_right' : matrix m n R ≃ₗ[Rᵐᵒᵖ] ((m → R) →ₗ[R] (n → R)) :=
linear_map.to_matrix_right'.symm

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

@[simp] lemma matrix.to_linear_map_right'_mul [fintype l] [decidable_eq l] (M : matrix l m R)
  (N : matrix m n R) : matrix.to_linear_map_right' (M ⬝ N) =
  (matrix.to_linear_map_right' N).comp (matrix.to_linear_map_right' M) :=
linear_map.ext $ λ x, (vec_mul_vec_mul _ M N).symm

lemma matrix.to_linear_map_right'_mul_apply [fintype l] [decidable_eq l] (M : matrix l m R)
  (N : matrix m n R) (x) : matrix.to_linear_map_right' (M ⬝ N) x =
    (matrix.to_linear_map_right' N (matrix.to_linear_map_right' M x)) :=
(vec_mul_vec_mul _ M N).symm

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

/-- If `M` and `M'` are each other's inverse matrices, they provide an equivalence between `n → A`
and `m → A` corresponding to `M.vec_mul` and `M'.vec_mul`. -/
@[simps]
def matrix.to_linear_equiv_right'_of_inv [fintype n] [decidable_eq n]
  {M : matrix m n R} {M' : matrix n m R}
  (hMM' : M ⬝ M' = 1) (hM'M : M' ⬝ M = 1) :
  (n → R) ≃ₗ[R] (m → R) :=
{ to_fun := M'.to_linear_map_right',
  inv_fun := M.to_linear_map_right',
  left_inv := λ x, by
    rw [← matrix.to_linear_map_right'_mul_apply, hM'M, matrix.to_linear_map_right'_one, id_apply],
  right_inv := λ x, by
    rw [← matrix.to_linear_map_right'_mul_apply, hMM', matrix.to_linear_map_right'_one, id_apply],
  ..linear_map.to_matrix_right'.symm M' }

end to_matrix_right

/-!
From this point on, we only work with commutative rings,
and fail to distinguish between `Rᵐᵒᵖ` and `R`.
This should eventually be remedied.
-/

section to_matrix'

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

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

variables [fintype n] [decidable_eq n]

lemma matrix.mul_vec_std_basis (M : matrix m n R) (i j) :
  M.mul_vec (std_basis R (λ _, R) j 1) i = M i j :=
(congr_fun (matrix.mul_vec_single _ _ (1 : R)) i).trans $ mul_one _

@[simp] lemma matrix.mul_vec_std_basis_apply (M : matrix m n R) (j) :
  M.mul_vec (std_basis R (λ _, R) j 1) = Mᵀ j :=
funext $ λ i, matrix.mul_vec_std_basis M i j

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

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

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

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

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

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

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

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

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

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

@[simp] lemma matrix.to_lin'_mul [fintype m] [decidable_eq m] (M : matrix l m R)
  (N : matrix m n R) : matrix.to_lin' (M ⬝ N) = (matrix.to_lin' M).comp (matrix.to_lin' N) :=
linear_map.ext $ λ x, (mul_vec_mul_vec _ _ _).symm

/-- Shortcut lemma for `matrix.to_lin'_mul` and `linear_map.comp_apply` -/
lemma matrix.to_lin'_mul_apply [fintype m] [decidable_eq m] (M : matrix l m R)
  (N : matrix m n R) (x) : matrix.to_lin' (M ⬝ N) x = (matrix.to_lin' M (matrix.to_lin' N x)) :=
by rw [matrix.to_lin'_mul, linear_map.comp_apply]

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

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

@[simp] lemma linear_map.to_matrix'_algebra_map (x : R) :
  linear_map.to_matrix' (algebra_map R (module.End R (n → R)) x) = scalar n x :=
by simp [module.algebra_map_End_eq_smul_id]

lemma matrix.ker_to_lin'_eq_bot_iff {M : matrix n n R} :
  M.to_lin'.ker = ⊥ ↔ ∀ v, M.mul_vec v = 0 → v = 0 :=
by simp only [submodule.eq_bot_iff, linear_map.mem_ker, matrix.to_lin'_apply]

/-- If `M` and `M'` are each other's inverse matrices, they provide an equivalence between `m → A`
and `n → A` corresponding to `M.mul_vec` and `M'.mul_vec`. -/
@[simps]
def matrix.to_lin'_of_inv [fintype m] [decidable_eq m]
  {M : matrix m n R} {M' : matrix n m R}
  (hMM' : M ⬝ M' = 1) (hM'M : M' ⬝ M = 1) :
  (m → R) ≃ₗ[R] (n → R) :=
{ to_fun := matrix.to_lin' M',
  inv_fun := M.to_lin',
  left_inv := λ x, by rw [← matrix.to_lin'_mul_apply, hMM', matrix.to_lin'_one, id_apply],
  right_inv := λ x, by rw [← matrix.to_lin'_mul_apply, hM'M, matrix.to_lin'_one, id_apply],
  .. matrix.to_lin' M' }

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

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

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

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

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

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

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

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

@[simp] lemma matrix.to_lin_alg_equiv'_one :
  matrix.to_lin_alg_equiv' (1 : matrix n n R) = id :=
matrix.to_lin'_one

@[simp] lemma linear_map.to_matrix_alg_equiv'_id :
  (linear_map.to_matrix_alg_equiv' (linear_map.id : (n → R) →ₗ[R] (n → R))) = 1 :=
linear_map.to_matrix'_id

@[simp] lemma matrix.to_lin_alg_equiv'_mul (M N : matrix n n R) :
  matrix.to_lin_alg_equiv' (M ⬝ N) =
    (matrix.to_lin_alg_equiv' M).comp (matrix.to_lin_alg_equiv' N) :=
matrix.to_lin'_mul _ _

lemma linear_map.to_matrix_alg_equiv'_comp (f g : (n → R) →ₗ[R] (n → R)) :
  (f.comp g).to_matrix_alg_equiv' = f.to_matrix_alg_equiv' ⬝ g.to_matrix_alg_equiv' :=
linear_map.to_matrix'_comp _ _

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

lemma matrix.rank_vec_mul_vec {K m n : Type u} [field K] [fintype n] [decidable_eq n]
  (w : m → K) (v : n → K) :
  rank (vec_mul_vec w v).to_lin' ≤ 1 :=
begin
  rw [vec_mul_vec_eq, matrix.to_lin'_mul],
  refine le_trans (rank_comp_le1 _ _) _,
  refine (rank_le_domain _).trans_eq _,
  rw [dim_fun', fintype.card_unit, nat.cast_one]
end

end to_matrix'

section to_matrix

variables {R : Type*} [comm_semiring R]
variables {l m n : Type*} [fintype n] [fintype m] [decidable_eq n]
variables {M₁ M₂ : Type*} [add_comm_monoid M₁] [add_comm_monoid M₂] [module R M₁] [module R M₂]
variables (v₁ : basis n R M₁) (v₂ : basis m R M₂)

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

/-- `linear_map.to_matrix'` is a particular case of `linear_map.to_matrix`, for the standard basis
`pi.basis_fun R n`. -/
lemma linear_map.to_matrix_eq_to_matrix' :
  linear_map.to_matrix (pi.basis_fun R n) (pi.basis_fun R n) = linear_map.to_matrix' :=
rfl

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

/-- `matrix.to_lin'` is a particular case of `matrix.to_lin`, for the standard basis
`pi.basis_fun R n`. -/
lemma matrix.to_lin_eq_to_lin' :
  matrix.to_lin (pi.basis_fun R n) (pi.basis_fun R m) = matrix.to_lin' :=
rfl

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

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

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

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

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

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

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

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

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

@[simp] lemma matrix.to_lin_self (M : matrix m n R) (i : n) :
  matrix.to_lin v₁ v₂ M (v₁ i) = ∑ j, M j i • v₂ j :=
begin
  rw [matrix.to_lin_apply, finset.sum_congr rfl (λ j hj, _)],
  rw [basis.repr_self, matrix.mul_vec, dot_product, finset.sum_eq_single i,
      finsupp.single_eq_same, mul_one],
  { intros i' _ i'_ne, rw [finsupp.single_eq_of_ne i'_ne.symm, mul_zero] },
  { intros,
    have := finset.mem_univ i,
    contradiction },
end

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

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

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

theorem linear_map.to_matrix_reindex_range [decidable_eq M₁] [decidable_eq M₂]
  (f : M₁ →ₗ[R] M₂) (k : m) (i : n) :
  linear_map.to_matrix v₁.reindex_range v₂.reindex_range f
      ⟨v₂ k, mem_range_self k⟩ ⟨v₁ i, mem_range_self i⟩ =
    linear_map.to_matrix v₁ v₂ f k i :=
by simp_rw [linear_map.to_matrix_apply, basis.reindex_range_self, basis.reindex_range_repr]

variables {M₃ : Type*} [add_comm_monoid M₃] [module R M₃] (v₃ : basis l R M₃)

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

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

@[simp] lemma linear_map.to_matrix_algebra_map (x : R) :
  linear_map.to_matrix v₁ v₁ (algebra_map R (module.End R M₁) x) = scalar n x :=
by simp [module.algebra_map_End_eq_smul_id, linear_map.to_matrix_id]

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

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

/-- Shortcut lemma for `matrix.to_lin_mul` and `linear_map.comp_apply`. -/
lemma matrix.to_lin_mul_apply [fintype l] [decidable_eq m]
  (A : matrix l m R) (B : matrix m n R) (x) :
  matrix.to_lin v₁ v₃ (A ⬝ B) x =
    (matrix.to_lin v₂ v₃ A) (matrix.to_lin v₁ v₂ B x) :=
by rw [matrix.to_lin_mul v₁ v₂, linear_map.comp_apply]

/-- If `M` and `M` are each other's inverse matrices, `matrix.to_lin M` and `matrix.to_lin M'`
form a linear equivalence. -/
@[simps]
def matrix.to_lin_of_inv [decidable_eq m]
  {M : matrix m n R} {M' : matrix n m R}
  (hMM' : M ⬝ M' = 1) (hM'M : M' ⬝ M = 1) :
  M₁ ≃ₗ[R] M₂ :=
{ to_fun := matrix.to_lin v₁ v₂ M,
  inv_fun := matrix.to_lin v₂ v₁ M',
  left_inv := λ x, by rw [← matrix.to_lin_mul_apply, hM'M, matrix.to_lin_one, id_apply],
  right_inv := λ x, by rw [← matrix.to_lin_mul_apply, hMM', matrix.to_lin_one, id_apply],
  .. matrix.to_lin v₁ v₂ M }

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

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

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

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

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

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

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

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

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

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

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

@[simp] lemma matrix.to_lin_alg_equiv_self (M : matrix n n R) (i : n) :
  matrix.to_lin_alg_equiv v₁ M (v₁ i) = ∑ j, M j i • v₁ j :=
matrix.to_lin_self _ _ _ _

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

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

theorem linear_map.to_matrix_alg_equiv_reindex_range [decidable_eq M₁]
  (f : M₁ →ₗ[R] M₁) (k i : n) :
  linear_map.to_matrix_alg_equiv v₁.reindex_range f
      ⟨v₁ k, mem_range_self k⟩ ⟨v₁ i, mem_range_self i⟩ =
    linear_map.to_matrix_alg_equiv v₁ f k i :=
by simp_rw [linear_map.to_matrix_alg_equiv_apply,
            basis.reindex_range_self, basis.reindex_range_repr]

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

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

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

end to_matrix

namespace algebra

section lmul

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

open algebra

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

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

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

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

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

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

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

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

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

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

variable [fintype n]

lemma smul_left_mul_matrix (x) (ik jk) :
  left_mul_matrix (b.smul c) x ik jk =
    left_mul_matrix b (left_mul_matrix c x ik.2 jk.2) ik.1 jk.1 :=
by simp only [left_mul_matrix_apply, linear_map.to_matrix_apply, mul_comm, basis.smul_apply,
              basis.smul_repr, finsupp.smul_apply, algebra.lmul_apply, id.smul_eq_mul,
              linear_equiv.map_smul, mul_smul_comm]

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

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

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

end lmul

end algebra

namespace linear_map

section finite_dimensional

open_locale classical

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

instance finite_dimensional : finite_dimensional K (V →ₗ[K] W) :=
linear_equiv.finite_dimensional
  (linear_map.to_matrix (basis.of_vector_space K V) (basis.of_vector_space K W)).symm

section

variables {A : Type*} [ring A] [algebra K A] [module A V] [is_scalar_tower K A V]
  [module A W] [is_scalar_tower K A W]

/-- Linear maps over a `k`-algebra are finite dimensional (over `k`) if both the source and
target are, since they form a subspace of all `k`-linear maps. -/
instance finite_dimensional' : finite_dimensional K (V →ₗ[A] W) :=
finite_dimensional.of_injective (restrict_scalars_linear_map K A V W)
  (restrict_scalars_injective _)

end

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

end finite_dimensional
end linear_map

section

variables {R : Type v} [comm_ring R] {n : Type*} [decidable_eq n]
variables {M M₁ M₂ : Type*} [add_comm_group M] [module R M]
variables [add_comm_group M₁] [module R M₁] [add_comm_group M₂] [module R M₂]

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

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

/-- A basis of a module induces an equivalence of algebras from the endomorphisms of the module to
square matrices. -/
def alg_equiv_matrix [fintype n] (h : basis n R M) : module.End R M ≃ₐ[R] matrix n n R :=
h.equiv_fun.alg_conj.trans alg_equiv_matrix'

end