/-
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 data.matrix.notation
import linear_algebra.matrix.finite_dimensional
import linear_algebra.std_basis
import ring_theory.algebra_tower
import algebra.module.algebra
import algebra.algebra.subalgebra.tower

/-!
# 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, of (λ 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,
                                             of_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,
      of_apply]
  end,
  map_add' := λ f g, by { ext i j, simp only [pi.add_apply, linear_map.add_apply, of_apply] },
  map_smul' := λ c f, by { ext i j, simp only [pi.smul_apply, linear_map.smul_apply,
                                               ring_hom.id_apply, of_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, of_apply],
  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]

lemma matrix.range_to_lin' (M : matrix m n R) : M.to_lin'.range = span R (range Mᵀ) :=
by simp_rw [range_eq_map, ←supr_range_std_basis, submodule.map_supr, range_eq_map,
  ←ideal.span_singleton_one, ideal.span, submodule.map_span, image_image, image_singleton,
  matrix.to_lin'_apply, M.mul_vec_std_basis_apply, supr_span, range_eq_Union]

/-- 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_apply, 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 }

@[simp] lemma linear_map.to_matrix_basis_equiv [fintype l] [decidable_eq l]
  (b : basis l R M₁) (b' : basis l R M₂) :
  linear_map.to_matrix b' b (b'.equiv b (equiv.refl l) : M₂ →ₗ[R] M₁) = 1 :=
begin
  ext i j,
  simp [linear_map.to_matrix_apply, matrix.one_apply, finsupp.single_apply, eq_comm],
end

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

@[simp] lemma matrix.to_lin_fin_two_prod_apply (a b c d : R) (x : R × R) :
  matrix.to_lin (basis.fin_two_prod R) (basis.fin_two_prod R) !![a, b; c, d] x =
    (a * x.fst + b * x.snd, c * x.fst + d * x.snd) :=
by simp [matrix.to_lin_apply, matrix.mul_vec, matrix.dot_product]

lemma matrix.to_lin_fin_two_prod (a b c d : R) :
  matrix.to_lin (basis.fin_two_prod R) (basis.fin_two_prod R) !![a, b; c, d] =
    (a • linear_map.fst R R R + b • linear_map.snd R R R).prod
    (c • linear_map.fst R R R + d • linear_map.snd R R R) :=
linear_map.ext $ matrix.to_lin_fin_two_prod_apply _ _ _ _

@[simp] lemma to_matrix_distrib_mul_action_to_linear_map (x : R) :
  linear_map.to_matrix v₁ v₁ (distrib_mul_action.to_linear_map R M₁ x) = matrix.diagonal (λ _, x) :=
begin
  ext,
  rw [linear_map.to_matrix_apply, distrib_mul_action.to_linear_map_apply, linear_equiv.map_smul,
    basis.repr_self, finsupp.smul_single_one, finsupp.single_eq_pi_single, matrix.diagonal_apply,
    pi.single_apply],
end

end to_matrix

namespace algebra

section lmul

variables {R S : Type*} [comm_ring R] [ring S] [algebra R S]
variables {m : Type*} [fintype m] [decidable_eq m] (b : basis m R S)

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 simp only [linear_map.to_matrix_apply', coe_lmul_eq_mul, linear_map.mul_apply']

@[simp] lemma to_matrix_lsmul (x : R) :
  linear_map.to_matrix b b (algebra.lsmul R S x) = matrix.diagonal (λ _, x) :=
to_matrix_distrib_mul_action_to_linear_map b x

/-- `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 `linear_map.mul_left`,
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_eq_diagonal,
                                  pi.algebra_map_def, algebra.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.mul_left R x).to_matrix_mul_vec_repr b b y

@[simp] lemma to_matrix_lmul_eq (x : S) :
  linear_map.to_matrix b b (linear_map.mul_left R 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'

end lmul

section lmul_tower

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

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, id.smul_eq_mul, linear_equiv.map_smul, mul_smul_comm,
  coe_lmul_eq_mul, linear_map.mul_apply']

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_tower

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, as 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


/-
Copyright (c) 2019 Seul Baek. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Seul Baek
-/

/-
Normalized linear integer arithmetic terms.
-/

import tactic.omega.coeffs

namespace omega

/-- Shadow syntax of normalized terms. The first element
    represents the constant term and the list represents
    the coefficients. -/
@[derive inhabited]
def term : Type := int × list int

namespace term

/-- Evaluate a term using the valuation v. -/
@[simp] def val (v : nat → int) : term → int
| (b,as) := b + coeffs.val v as

@[simp] def neg : term → term
| (b,as) := (-b, list.func.neg as)

@[simp] def add : term → term → term
| (c1,cfs1) (c2,cfs2) := (c1+c2, list.func.add cfs1 cfs2)

@[simp] def sub : term → term → term
| (c1,cfs1) (c2,cfs2) := (c1 - c2, list.func.sub cfs1 cfs2)

@[simp] def mul (i : int) : term → term
| (b,as) := (i * b, as.map ((*) i))

@[simp] def div (i : int) : term → term
| (b,as) := (b/i, as.map (λ x, x / i))

lemma val_neg {v : nat → int} {t : term} :
(neg t).val v = -(t.val v) :=
begin
  cases t with b as,
  simp only [val, neg_add, neg, val, coeffs.val_neg]
end

@[simp] lemma val_sub {v : nat → int} {t1 t2 : term} :
(sub t1 t2).val v = t1.val v - t2.val v :=
begin
  cases t1, cases t2,
  simp only [add_assoc, coeffs.val_sub, neg_add_rev,
    val, sub, add_comm, add_left_comm, sub_eq_add_neg]
end

@[simp] lemma val_add {v : nat → int} {t1 t2 : term} :
(add t1 t2).val v = t1.val v + t2.val v :=
begin
  cases t1, cases t2,
  simp only [coeffs.val_add, add,
    val, add_comm, add_left_comm]
end

@[simp] lemma val_mul {v : nat → int} {i : int} {t : term} :
val v (mul i t) = i * (val v t) :=
begin
  cases t,
  simp only [mul, mul_add, add_mul, list.length_map,
    coeffs.val, coeffs.val_between_map_mul, val, list.map]
end

lemma val_div {v : nat → int} {i b : int} {as : list int} :
  i ∣ b → (∀ x ∈ as, i ∣ x) → (div i (b,as)).val v = (val v (b,as)) / i :=
begin
  intros h1 h2, simp only [val, div, list.map],
  rw [int.add_div_of_dvd_left h1],
  apply fun_mono_2 rfl,
  rw ← coeffs.val_map_div h2
end

/-- Fresh de Brujin index not used by any variable ocurring in the term -/
def fresh_index (t : term) : nat := t.snd.length

def to_string (t : term) : string :=
t.2.enum.foldr (λ ⟨i, n⟩ r,
  to_string n ++ " * x" ++ to_string i ++ " + " ++ r) (to_string t.1)

instance : has_to_string term := ⟨to_string⟩

end term

/-- Fresh de Brujin index not used by any variable ocurring in the list of terms -/
def terms.fresh_index : list term → nat
| []      := 0
| (t::ts) := max t.fresh_index (terms.fresh_index ts)

end omega


/-
Copyright (c) 2022 María Inés de Frutos-Fernández. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: María Inés de Frutos-Fernández
-/
import ring_theory.class_group
import adeles_function_field
import ideles_R

/-!
# The group of idèles of a function field
We define the group of finite idèles and the group of idèles of a function field `F`, both of which
are topological commutative groups.

We also prove that `F*` can be regarded as a subgroup of `I_F_f` and `I_F` and define the idèle
class group of `F` as the quotient `I_F/F*`. We then show that the ideal class group of `F` is
isomorphic to an explicit quotient of `C_F` as topological groups, by constructing a continuous
surjective group homomorphism from `C_F` to the ideal class group `Cl(F)` of `F` and
computing its kernel.

## Main definitions
- `function_field.I_F_f` : The finite idèle group of the function field `F`.
- `function_field.I_F`   : The idèle group of the function field `F`.
- `function_field.C_F`   : The idèle class group of the function field `F`.
- `function_field.C_F.map_to_class_group` : The natural group homomorphism from `C_F` to `Cl(F)`.

## Main results
- `function_field.C_F.map_to_class_group.surjective` : The natural map `C_F → Cl(F)` is surjective.
- `function_field.C_F.map_to_class_group.continuous` : The natural map `C_F → Cl(F)` is continuous.
- `function_field.C_F.map_to_class_group.mem_kernel_iff` : We compute the kernel of `C_F → Cl(F)`.

## References
* [J.W.S. Cassels, A. Frölich, *Algebraic Number Theory*][cassels1967algebraic]

## Tags
idèle group, number field, function field
-/

noncomputable theory

open set function
open_locale tensor_product

namespace function_field
/-! ### The idèle group of a function field
We define the (finite) idèle group of a function field `F`, with its topological group structure. -/

variables (k F : Type) [field k] [field F] [algebra (polynomial k) F] [algebra (ratfunc k) F]
  [function_field k F] [is_scalar_tower (polynomial k) (ratfunc k) F]
  [is_separable (ratfunc k) F]

/-- The finite idèle group of the function field `F`. -/
def I_F_f := units (A_F_f k F)
/-- The idèle group of the function field `F`.-/
def I_F := units (A_F k F)

instance : comm_group (I_F_f k F) := units.comm_group
instance : comm_group (I_F k F) := units.comm_group
instance : inhabited (I_F_f k F) := ⟨1⟩
instance : inhabited (I_F k F) := ⟨1⟩
instance : topological_space (I_F_f k F) :=
finite_idele_group'.topological_space (ring_of_integers k F) F
instance : topological_group (I_F_f k F) :=
finite_idele_group'.topological_group (ring_of_integers k F) F
instance : topological_space (I_F k F) := units.topological_space
instance : topological_group (I_F k F) := units.topological_group

/-- `I_F` is isomorphic to the product `I_F_f × ((kt_infty k) ⊗[ratfunc k] F)*`, as groups. -/
def I_F.as_prod : I_F k F ≃* (I_F_f k F) × units ((kt_infty k) ⊗[ratfunc k] F) :=
by apply @mul_equiv.prod_units (A_F_f k F) ((kt_infty k) ⊗[ratfunc k] F) _ _

/-- `I_F` is homeomorphic to the product `I_F_f × ((kt_infty k) ⊗[ratfunc k] F)*`. -/
def I_F.as_prod.homeo : homeomorph (I_F k F) ((I_F_f k F) × units ((kt_infty k) ⊗[ratfunc k] F)) :=
units.homeomorph.prod_units

variables {k F}
lemma I_F.as_prod.continuous : continuous ((I_F.as_prod k F).to_fun) :=
(I_F.as_prod.homeo k F).continuous_to_fun
lemma I_F.as_prod.continuous_inv : continuous ((I_F.as_prod k F).inv_fun) :=
(I_F.as_prod.homeo k F).continuous_inv_fun

/-- Construct an idèle of `F` given a finite idèle and a unit of `(kt_infty k) ⊗[ratfunc k] F`. -/
def I_F.mk (x : I_F_f k F) (u : units ((kt_infty k) ⊗[ratfunc k] F)) : I_F k F :=
(I_F.as_prod k F).inv_fun (prod.mk x u)

variables (k F)

 /-- The projection from `I_F` to `I_F_f`, as a group homomorphism. -/
def I_F.fst : monoid_hom (I_F k F) (I_F_f k F) :=
{ to_fun := λ x, ((I_F.as_prod k F).to_fun x).1,
  map_one' := by {rw [mul_equiv.to_fun_eq_coe, mul_equiv.map_one, prod.fst_one]},
  map_mul' := λ x y, by {simp only [prod.fst_mul, mul_equiv.to_fun_eq_coe, mul_equiv.map_mul]}}

variables {k F}
/-- The projection map `I_F.fst` is surjective. -/
lemma I_F.fst.surjective : function.surjective (I_F.fst k F) :=
begin
  intro x,
  use I_F.mk x (1 : units ((kt_infty k) ⊗[ratfunc k] F)),
  rw [I_F.fst, monoid_hom.coe_mk, mul_equiv.to_fun_eq_coe, I_F.mk,
    mul_equiv.inv_fun_eq_symm, mul_equiv.apply_symm_apply],
end

/-- The projection map `I_F.fst` is continuous. -/
lemma I_F.fst.continuous : continuous (I_F.fst k F) :=
continuous.comp continuous_fst I_F.as_prod.continuous

lemma right_inv (x : units F) : (inj_F.ring_hom k F) x.val * (inj_F.ring_hom k F) x.inv = 1 :=
begin
  rw [← (inj_F.ring_hom k F).map_mul, units.val_eq_coe, units.inv_eq_coe_inv, units.mul_inv],
  exact (inj_F.ring_hom k F).map_one
end

lemma left_inv (x : units F) : (inj_F.ring_hom k F) x.inv * (inj_F.ring_hom k F) x.val  = 1 :=
by rw [mul_comm, right_inv]

variables (k F)
/-- The map from `F^*` to `I_F` sending `x` to `((x)_v, 1 ⊗ x)`. -/
def inj_units_F : units F → I_F k F := units.map (inj_F.ring_hom k F).to_monoid_hom

variables {k F}
@[simp] lemma inj_units_F.map_one : inj_units_F k F 1 = 1 := by rw [inj_units_F, map_one]

@[simp] lemma inj_units_F.map_mul (x y : units F) :
  inj_units_F k F (x*y) = (inj_units_F k F x) * (inj_units_F k F y) := by rw [inj_units_F, map_mul]

variables (k F)
/-- `inj_units_F` is a group homomorphism. -/
def inj_units_F.group_hom : monoid_hom (units F) (I_F k F) :=
{ to_fun    := inj_units_F k F,
  map_one'  := inj_units_F.map_one,
  map_mul'  := inj_units_F.map_mul, }

/-- `inj_units_F` is injective. -/
lemma inj_units_F.injective : injective (inj_units_F k F) :=
begin
  intros x y hxy,
  simp only [inj_units_F, units.map, monoid_hom.mk', ring_hom.coe_monoid_hom, monoid_hom.coe_mk,
    ← units.eq_iff, units.coe_mk] at hxy,
  ext,
  exact inj_F.injective k F hxy,
end

/-- The idèle class group of `F` is the quotient of `I_F` by the group `F*` of principal idèles. -/
def C_F := (I_F k F) ⧸ (inj_units_F.group_hom k F).range

instance : comm_group (C_F k F) :=
quotient_group.has_quotient.quotient.comm_group ((inj_units_F.group_hom k F).range)

instance : inhabited (C_F k F) := ⟨1⟩
instance : topological_space (C_F k F) := quotient.topological_space

instance : topological_group (C_F k F) :=
topological_group_quotient ((inj_units_F.group_hom k F).range)

/-- The `v`-adic absolute value of the `v`th component of the idèle `x`. -/
def v_comp_val (x : I_F k F) (v : maximal_spectrum (ring_of_integers k F)) :
  with_zero (multiplicative ℤ) := valued.v (x.val.1.val v)

/-- The `v`-adic absolute value of the inverse of the `v`th component of the idèle `x`. -/
def v_comp_inv (x : I_F k F) (v : maximal_spectrum (ring_of_integers k F)) :
  with_zero (multiplicative ℤ) := valued.v (x.inv.1.val v)

/-- For any finite idèle `x`, there are finitely many maximal ideals `v` of `R` for which
`x_v ∉ R_v` or `x⁻¹_v ∉ R_v`. -/
lemma I_F_f.restricted_product (x : I_F_f k F) : finite
  ({ v : maximal_spectrum (ring_of_integers k F) | ¬ (x.val.val v) ∈ v.adic_completion_integers F }
  ∪ { v : maximal_spectrum (ring_of_integers k F) |
    ¬ (x.inv.val v) ∈ v.adic_completion_integers F }) :=
restricted_product (ring_of_integers k F) F x

lemma prod_val_inv_eq_one (x : I_F k F) (v : maximal_spectrum (ring_of_integers k F)) :
  (x.val.fst.val v) * (x.inv.fst.val v) = 1  :=
begin
  rw [← pi.mul_apply, mul_apply_val, ← prod.fst_mul, units.val_inv,
    prod.fst_one, subtype.val_eq_coe, ← one_def, subtype.coe_mk],
  refl,
end

lemma valuation.prod_val_inv_eq_one (x : I_F k F) (v : maximal_spectrum (ring_of_integers k F)) :
  (v_comp_val k F x v) * (v_comp_inv k F x v) = 1 :=
begin
  simp only [v_comp_val, v_comp_inv],
  rw [← valued.v.map_mul, prod_val_inv_eq_one k F x v],
  exact valuation.map_one _,
end

lemma v_comp.ne_zero (x : I_F k F) (v : maximal_spectrum (ring_of_integers k F)) :
  (x.val.1.val v) ≠ 0 := left_ne_zero_of_mul_eq_one (prod_val_inv_eq_one k F x v)

/-- For any idèle `x`, there are finitely many maximal ideals `v` of `R` for which `x_v ∉ R_v` or
`x⁻¹_v ∉ R_v`. -/
lemma I_F.restricted_product (x : I_F k F) : finite ({ v : maximal_spectrum (ring_of_integers k F) |
    (¬ (x.val.1.val v) ∈ v.adic_completion_integers F) } ∪ { v : maximal_spectrum
    (ring_of_integers k F) | ¬ (x.inv.1.val v) ∈ v.adic_completion_integers F}) :=
finite.union x.val.1.property x.inv.1.property

/-- For any idèle `x`, there are finitely many maximal ideals `v` of `R` for which `|x_v|_v ≠ 1`. -/
lemma I_F.finite_exponents (x : I_F k F) :
  finite { v : maximal_spectrum (ring_of_integers k F) | v_comp_val k F x v ≠ 1 } :=
begin
  have h_subset : { v : maximal_spectrum (ring_of_integers k F) | v_comp_val k F x v ≠ 1 } ⊆
  { v : maximal_spectrum (ring_of_integers k F) | ¬ (x.val.1.val v) ∈ v.adic_completion_integers F } ∪
  { v : maximal_spectrum (ring_of_integers k F) | ¬ (x.inv.1.val v) ∈ v.adic_completion_integers F },
  { intros v hv,
    rw [mem_union, mem_set_of_eq, mem_set_of_eq, adic_completion.is_integer,
      adic_completion.is_integer],
    rw mem_set_of_eq at hv,
    cases (lt_or_gt_of_ne hv) with hlt hgt,
    { right,
      have h_one : (v_comp_val k F x v) * (v_comp_inv k F x v) = 1 :=
      valuation.prod_val_inv_eq_one k F x v,
      have h_inv : 1 < v_comp_inv k F x v,
      { have hx : v_comp_val k F x v ≠ 0,
        { rw [v_comp_val, valuation.ne_zero_iff],
          exact v_comp.ne_zero k F x v,},
        rw mul_eq_one_iff_inv_eq₀ hx at h_one,
        rw [← h_one, ← with_zero.inv_one, inv_lt_inv₀ (ne.symm zero_ne_one) hx],
        exact hlt, },
      exact not_le.mpr h_inv,},
    { left, exact not_le.mpr hgt, }},
  exact finite.subset (I_F.restricted_product k F x) h_subset,
end

/-- The natural map from `I_F_f` to the group of invertible fractional ideals of `F`, sending a
finite idèle `x` to the product `∏_v v^(val_v(x_v))`, where `val_v` denotes the additive
`v`-adic valuation. -/
def I_F_f.map_to_fractional_ideals : monoid_hom
  (I_F_f k F) (units (fractional_ideal (non_zero_divisors (ring_of_integers k F)) F)) :=
map_to_fractional_ideals (ring_of_integers k F) F

variables {k F}
/-- `I_F_f.map_to_fractional_ideals` is surjective. -/
lemma I_F_f.map_to_fractional_ideals.surjective :
  function.surjective (I_F_f.map_to_fractional_ideals k F) :=
@map_to_fractional_ideals.surjective (ring_of_integers k F) F _ _ _ _ _ _

/-- A finite idèle `x` is in the kernel of `I_F_f.map_to_fractional_ideals` if and only if
`|x_v|_v = 1` for all `v`. -/
lemma I_F_f.map_to_fractional_ideals.mem_kernel_iff (x : I_F_f k F) :
  I_F_f.map_to_fractional_ideals k F x = 1 ↔
  ∀ v : maximal_spectrum (ring_of_integers k F),
    finite_idele.to_add_valuations (ring_of_integers k F) F x v = 0 :=
@map_to_fractional_ideals.mem_kernel_iff (ring_of_integers k F) F _ _ _ _ _ _ x

/-- `I_F_f.map_to_fractional_ideals` is continuous. -/
lemma I_F_f.map_to_fractional_ideals.continuous :
  continuous (I_F_f.map_to_fractional_ideals k F) :=
@map_to_fractional_ideals.continuous (ring_of_integers k F) F _ _ _ _ _ _

variables (k F)
/-- The natural map from `I_F` to the group of invertible fractional ideals of `F`. -/
def I_F.map_to_fractional_ideals :
  monoid_hom (I_F k F) (units (fractional_ideal (non_zero_divisors (ring_of_integers k F)) F)) :=
monoid_hom.comp (I_F_f.map_to_fractional_ideals k F) (I_F.fst k F)

variables {k F}
/-- `I_F.map_to_fractional_ideals` is surjective. -/
lemma I_F.map_to_fractional_ideals.surjective :
  function.surjective (I_F.map_to_fractional_ideals k F) :=
function.surjective.comp I_F_f.map_to_fractional_ideals.surjective I_F.fst.surjective

/-- An idèle `x` is in the kernel of `I_F_f.map_to_fractional_ideals` if and only if `|x_v|_v = 1`
for all `v`. -/
lemma I_F.map_to_fractional_ideals.mem_kernel_iff (x : I_F k F) :
  I_F.map_to_fractional_ideals k F x = 1 ↔
  ∀ v : maximal_spectrum (ring_of_integers k F),
    finite_idele.to_add_valuations (ring_of_integers k F) F (I_F.fst k F x) v = 0 :=
I_F_f.map_to_fractional_ideals.mem_kernel_iff (I_F.fst k F x)

/-- `I_F.map_to_fractional_ideals` is continuous. -/
lemma I_F.map_to_fractional_ideals.continuous :
  continuous (I_F.map_to_fractional_ideals k F) :=
continuous.comp I_F_f.map_to_fractional_ideals.continuous I_F.fst.continuous

variables (k F)
/-- The map from `I_F_f` to the ideal  class group of `F` induced by
`I_F_f.map_to_fractional_ideals`. -/
def I_F_f.map_to_class_group :
  (I_F_f k F) → (class_group (ring_of_integers k F) F) :=
λ x, quotient_group.mk (I_F_f.map_to_fractional_ideals k F x)

instance : topological_space (class_group ↥(ring_of_integers k F) F) := ⊥

instance : topological_group (class_group ↥(ring_of_integers k F) F) :=
{ continuous_mul := continuous_of_discrete_topology,
  continuous_inv := continuous_of_discrete_topology, }

variables {k F}
lemma I_F_f.map_to_class_group.surjective : surjective (I_F_f.map_to_class_group k F) :=
surjective.comp quotient.surjective_quotient_mk' I_F_f.map_to_fractional_ideals.surjective

lemma I_F_f.map_to_class_group.continuous : continuous (I_F_f.map_to_class_group k F) :=
continuous.comp continuous_bot (I_F_f.map_to_fractional_ideals.continuous)

variables (k F)
/-- The map from `I_F` to the ideal  class group of `K` induced by
`I_F.map_to_fractional_ideals`. -/
def I_F.map_to_class_group :
  (I_F k F) → (class_group (ring_of_integers k F) F) :=
λ x, quotient_group.mk' _ (I_F.map_to_fractional_ideals k F x)

variables {k F}
lemma I_F.map_to_class_group.surjective : surjective (I_F.map_to_class_group k F) :=
surjective.comp quotient.surjective_quotient_mk' I_F.map_to_fractional_ideals.surjective

lemma I_F.map_to_class_group.continuous : continuous (I_F.map_to_class_group k F) :=
continuous.comp continuous_bot I_F.map_to_fractional_ideals.continuous

variables {k F}
lemma I_F.map_to_class_group.map_one : I_F.map_to_class_group k F 1 = 1 :=
by {simp only [I_F.map_to_class_group, monoid_hom.map_one] }

lemma I_F.map_to_class_group.map_mul (x y : I_F k F) : I_F.map_to_class_group k F (x * y) =
  I_F.map_to_class_group k F x * I_F.map_to_class_group k F y :=
by {simp only [I_F.map_to_class_group, monoid_hom.map_mul] }

/-- The map from `I_F` to the ideal  class group of `F` induced by
`I_F.map_to_fractional_ideals` is a group homomorphism. -/
def I_F.monoid_hom_to_class_group : (I_F k F) →* (class_group (ring_of_integers k F) F) :=
{ to_fun   := I_F.map_to_class_group k F,
  map_one' := I_F.map_to_class_group.map_one,
  map_mul' := λ x y, I_F.map_to_class_group.map_mul x y }

lemma I_F_f.unit_image.mul_inv (x : units F) :
  ((inj_F_f.ring_hom k F) x.val) * ((inj_F_f.ring_hom k F) x.inv) = 1 :=
by rw [← ring_hom.map_mul, units.val_eq_coe, units.inv_eq_coe_inv, units.mul_inv, ring_hom.map_one]

lemma I_F_f.unit_image.inv_mul (x : units F):
  ((inj_F_f.ring_hom k F) x.inv) * ((inj_F_f.ring_hom k F) x.val) = 1 :=
by rw [mul_comm, I_F_f.unit_image.mul_inv]

open_locale classical

/-- `I_F_f.map_to_fractional_ideals` sends the principal finite idèle `(x)_v` corresponding to
`x ∈ F*` to the principal fractional ideal generated by `x`. -/
lemma I_F_f.map_to_fractional_ideal.map_units (x : units F) :
  fractional_ideal.span_singleton (non_zero_divisors ↥(ring_of_integers k F)) (x : F) =
  ((I_F_f.map_to_fractional_ideals k F) (units.mk ((inj_F_f.ring_hom k F) x.val)
  ((inj_F_f.ring_hom k F) x.inv) (I_F_f.unit_image.mul_inv x) (I_F_f.unit_image.inv_mul x))) :=
begin
  set I := (fractional_ideal.span_singleton (non_zero_divisors ↥(ring_of_integers k F)) (x : F))
    with hI_def,
  have hI : I ≠ 0,
  { rw [hI_def, fractional_ideal.span_singleton_ne_zero_iff],
    exact units.ne_zero x },
  rw ← fractional_ideal.factorization_principal I hI x hI_def,
  apply finprod_congr,
  intro v,
  apply congr_arg,
  rw finite_idele.to_add_valuations,
  simp only,
  rw [with_zero.to_integer, ← injective.eq_iff multiplicative.of_add.injective, of_add_neg,
    of_add_to_add, ← neg_sub_neg, of_add_sub, ← inv_div'],
  apply congr_arg,
  have hv : valued.v (((inj_F_f.ring_hom k F) x.val).val v) ≠ (0 : with_zero (multiplicative ℤ)),
  { rw [valuation.ne_zero_iff, inj_F_f.ring_hom.v_comp, units.val_eq_coe,
      ← uniform_space.completion.coe_zero,
      injective.ne_iff (@uniform_space.completion.coe_inj F v.us' v.ss)],
    exact units.ne_zero x },
  let z :=  classical.some (with_zero.to_integer._proof_1 hv),
  let hz :=  classical.some_spec (with_zero.to_integer._proof_1 hv),
  rw [← with_zero.coe_inj, hz, v.valued_adic_completion_def, inj_F_f.ring_hom,
    inj_K.ring_hom_apply, inj_K_apply, valued.extension_extends, units.val_eq_coe,
    v.adic_valued_def, maximal_spectrum.valuation_def],
  simp only,
  rw [with_zero.coe_div, maximal_spectrum.int_valuation_def_if_neg v
    (non_zero_divisors.coe_ne_zero _), maximal_spectrum.int_valuation_def_if_neg],
  { rw [ne.def, ← @is_fraction_ring.mk'_eq_zero_iff_eq_zero _ _ F _ _ _ _ _],
    convert units.ne_zero x,
    exact classical.some_spec (classical.some_spec
    (maximal_spectrum.valuation_def._proof_1 (x : F))), },
end

/-- `I_F.map_to_fractional_ideals` sends the principal idèle `(x)_v` corresponding to `x ∈ F*` to
the principal fractional ideal generated by `x`. -/
lemma I_F.map_to_fractional_ideals.map_units_F (x : units F) :
  fractional_ideal.span_singleton (non_zero_divisors ↥(ring_of_integers k F)) (x : F) =
  ↑((I_F.map_to_fractional_ideals k F) ((inj_units_F.group_hom k F) x)) :=
I_F_f.map_to_fractional_ideal.map_units x

/-- The kernel of `I_F.map_to_fractional_ideals` contains the principal idèles `(x)_v`, for
`x ∈ F*`. -/
lemma I_F.map_to_class_group.map_units_F (x : units F) :
  I_F.map_to_class_group k F ((inj_units_F.group_hom k F) x) = 1 :=
begin
  simp only [I_F.map_to_class_group],
  rw [quotient_group.mk'_apply, quotient_group.eq_one_iff, monoid_hom.mem_range],
  simp only [to_principal_ideal_eq_iff],
  use x,
  exact I_F.map_to_fractional_ideals.map_units_F x,
end

/-- Every nonzero element in a field is a unit. -/
def field.units.mk' {F : Type*} [field F] (k : F) (hk : k ≠ 0) : units F :=
{ val     := k,
  inv     := k⁻¹,
  val_inv := mul_inv_cancel hk,
  inv_val := inv_mul_cancel hk}

lemma I_F.map_to_fractional_ideals.apply (x : I_F k F) : (((I_F.map_to_fractional_ideals k F) x) :
  fractional_ideal (non_zero_divisors ↥(ring_of_integers k F)) F) =
  finprod (λ (v : maximal_spectrum ↥(ring_of_integers k F)),
    (v.as_ideal : fractional_ideal (non_zero_divisors ↥(ring_of_integers k F)) F)^
    finite_idele.to_add_valuations ↥(ring_of_integers k F) F ((I_F.fst k F) x) v) := rfl

/-- If the image of `x ∈ I_F` under `I_F.map_to_class_group` is the principal fractional ideal
generated by `u ∈ F*`, then for every maximal ideal `v` of the ring of integers of `F`,
`|x_v|_v = |u|_v`. -/
lemma I_F.map_to_class_group.valuation_mem_kernel (x : I_F k F) (u : units F)
  (v : maximal_spectrum (ring_of_integers k F))
  (hux : fractional_ideal.span_singleton (non_zero_divisors ↥(ring_of_integers k F)) (u : F) =
    (((I_F.map_to_fractional_ideals k F) x) :
      fractional_ideal (non_zero_divisors ↥(ring_of_integers k F)) F)) :
  valued.v (((I_F.fst k F) x).val.val v) = valued.v ((coe : F → v.adic_completion F) u.val) :=
begin
  set nu := classical.some (is_localization.mk'_surjective
    (non_zero_divisors ↥(ring_of_integers k F)) (u : F)) with h_nu,
  set du' := classical.some (classical.some_spec (is_localization.mk'_surjective
    (non_zero_divisors ↥(ring_of_integers k F)) (u : F))) with h_du',
  set du : ↥(ring_of_integers k F) := ↑du' with h_du,
  have h := classical.some_spec (classical.some_spec (is_localization.mk'_surjective
    (non_zero_divisors ↥(ring_of_integers k F)) (u : F))),
  rw [← h_du', ← h_nu] at h,
  have h_nu_ne_zero : nu ≠ 0,
  { intro h_contr,
    rw [h_contr, is_localization.mk'_zero] at h,
    exact (units.ne_zero u) (eq.symm h)},
  have h_du_ne_zero : du ≠ 0,
  { rw h_du,
    exact non_zero_divisors.coe_ne_zero _, },
  rw I_F.map_to_fractional_ideals.apply at hux,
  { have h_exps_v:  ((associates.mk v.as_ideal).count
      (associates.mk (ideal.span {nu})).factors : ℤ) -
      ((associates.mk v.as_ideal).count (associates.mk (ideal.span {du})).factors : ℤ) =
      finite_idele.to_add_valuations ↥(ring_of_integers k F) F ((I_F.fst k F) x) v,
    { rw [← fractional_ideal.count_finprod F v (finite_idele.to_add_valuations
        ↥(ring_of_integers k F) F ((I_F.fst k F) x)) (finite_add_support _ _ _), ← hux,  eq_comm],
      apply fractional_ideal.count_well_defined F v,
      { rw fractional_ideal.span_singleton_ne_zero_iff,
        exact units.ne_zero u, },
      { rw [fractional_ideal.coe_ideal_span_singleton,
          fractional_ideal.span_singleton_mul_span_singleton, ← h, is_fraction_ring.mk'_eq_div,
          h_du, div_eq_inv_mul], }},
    simp only [finite_idele.to_add_valuations, with_zero.to_integer, eq_neg_iff_eq_neg, neg_sub]
      at h_exps_v,
    conv_rhs {rw [v.valued_adic_completion_def, units.val_eq_coe], },
    rw [valued.extension_extends, v.adic_valued_def],
    simp only [maximal_spectrum.valuation_def],
    rw [← h_du, ← h_nu, maximal_spectrum.int_valuation_def_if_neg,
    maximal_spectrum.int_valuation_def_if_neg, ← with_zero.coe_div, ← of_add_sub, neg_sub_neg,
    ← h_exps_v, of_add_to_add, eq_comm],
    exact classical.some_spec (with_zero.to_integer._proof_1 _),
    { exact h_du_ne_zero },
    { exact h_nu_ne_zero }},
end

/-- An element `x ∈ I_F` is in the kernel of `C_F → Cl(F)` if and only if there exist `u ∈ F*` and
`y ∈ I_F` such that `x = u*y` and `|y_v|_v = 1` for all `v`. -/
lemma I_F.map_to_class_group.mem_kernel_iff (x : I_F k F) :
  I_F.map_to_class_group k F x = 1 ↔ ∃ (u : F) (hu : u ≠ 0),
  ∀ v : maximal_spectrum (ring_of_integers k F),
    (finite_idele.to_add_valuations ↥(ring_of_integers k F) F ((I_F.fst k F) x) v)
    = -with_zero.to_integer (units.valuation_ne_zero (ring_of_integers k F) F v hu) :=
begin
  rw [I_F.map_to_class_group, quotient_group.coe_mk', quotient_group.eq_one_iff,
      monoid_hom.mem_range],
    simp_rw [to_principal_ideal_eq_iff],
  refine ⟨λ h, _, λ h, _⟩,
 { obtain ⟨u, hu⟩ := h,
    use [(u : F), units.ne_zero u],
    intro v,
    rw [finite_idele.to_add_valuations, neg_inj, with_zero.to_integer,
      with_zero.to_integer, injective.eq_iff multiplicative.to_add.injective],
    apply classical.some_spec2,
    intros a ha,
    rw eq_comm,
    apply classical.some_spec2,
    intros b hb,
    have h_valuations : valued.v (((I_F.fst k F) x).val.val v) =
      valued.v ((coe : F → v.adic_completion F) (u : F)),
    { apply I_F.map_to_class_group.valuation_mem_kernel x u v hu },
    rw [← h_valuations, ← hb] at ha,
    rw ← with_zero.coe_inj,
    exact ha, },
  { obtain ⟨u, hu, h_vals⟩ := h,
    use field.units.mk' u hu,
    rw [I_F.map_to_fractional_ideals.map_units_F, I_F.map_to_fractional_ideals,
      I_F_f.map_to_fractional_ideals, map_to_fractional_ideals, monoid_hom.coe_comp,
      comp_app, monoid_hom.coe_mk,map_to_fractional_ideals.def, units.coe_mk],
    simp only [map_to_fractional_ideals.val],
    apply finprod_congr,
    intro v,
    rw h_vals v,
    refl, }
  end

variables (k F)
/-- The map `C_F → Cl(F)` induced by `I_F.map_to_class_group`. -/
def C_F.map_to_class_group :
  (C_F k F) →* (class_group (ring_of_integers k F) F) :=
begin
  apply quotient_group.lift (inj_units_F.group_hom k F).range I_F.monoid_hom_to_class_group _,
  { intros x hx,
    obtain ⟨u, hu⟩ := hx,
    rw ← hu,
    exact I_F.map_to_class_group.map_units_F u, },
end

/-- The natural map `C_F → Cl(F)` is surjective. -/
lemma C_F.map_to_class_group.surjective :
  surjective (C_F.map_to_class_group k F) :=
begin
  intro y,
  obtain ⟨x, hx⟩ := I_F.map_to_class_group.surjective y,
  use [quotient_group.mk x, hx],
end

/-- The natural map `C_F → Cl(F)` is continuous. -/
lemma C_F.map_to_class_group.continuous :
  continuous (C_F.map_to_class_group k F) :=
continuous_quot_lift (quotient_group.lift._proof_1
  (inj_units_F.group_hom k F).range I_F.monoid_hom_to_class_group
  (C_F.map_to_class_group._proof_4 k F)) I_F.map_to_class_group.continuous

/-- An element `x ∈ C_F` is in the kernel of `C_F → Cl(F)` if and only if `x` comes from an idèle
of the form `u*y`, with `u ∈ F*` and `|y_v|_v = 1` for all `v`. -/
lemma C_F.map_to_class_group.mem_kernel_iff (x : C_F k F) :
  C_F.map_to_class_group k F x = 1 ↔
  ∃ (u : F) (hu : u ≠ 0), ∀ v : maximal_spectrum (ring_of_integers k F),
    (finite_idele.to_add_valuations ↥(ring_of_integers k F) F
      ((I_F.fst k F) (classical.some (quot.exists_rep x))) v)
      = -with_zero.to_integer (units.valuation_ne_zero (ring_of_integers k F) F v hu) :=
begin
  set z := classical.some (quot.exists_rep x) with hz_def,
  have hz := classical.some_spec (quot.exists_rep x),
  have : C_F.map_to_class_group k F x =
    I_F.map_to_class_group k F (classical.some (quot.exists_rep x)),
  { rw [← hz_def, ← hz, C_F.map_to_class_group, ← hz_def, quotient_group.lift_quot_mk],
    refl },
  rw this,
  exact I_F.map_to_class_group.mem_kernel_iff _,
end

end function_field


/-
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
-/
import algebra.char_p.basic
import algebra.group_with_zero.power
import algebra.hom.iterate
import algebra.ring.equiv

/-!
# The perfect closure of a field
-/

universes u v

open function

section defs

variables (R : Type u) [comm_semiring R] (p : ℕ) [fact p.prime] [char_p R p]

/-- A perfect ring is a ring of characteristic p that has p-th root. -/
class perfect_ring : Type u :=
(pth_root' : R → R)
(frobenius_pth_root' : ∀ x, frobenius R p (pth_root' x) = x)
(pth_root_frobenius' : ∀ x, pth_root' (frobenius R p x) = x)

/-- Frobenius automorphism of a perfect ring. -/
def frobenius_equiv [perfect_ring R p] : R ≃+* R :=
{ inv_fun := perfect_ring.pth_root' p,
  left_inv := perfect_ring.pth_root_frobenius',
  right_inv := perfect_ring.frobenius_pth_root',
  .. frobenius R p }

/-- `p`-th root of an element in a `perfect_ring` as a `ring_hom`. -/
def pth_root [perfect_ring R p] : R →+* R :=
(frobenius_equiv R p).symm

end defs

section

variables {R : Type u} [comm_semiring R] {S : Type v} [comm_semiring S] (f : R →* S) (g : R →+* S)
  {p : ℕ} [fact p.prime] [char_p R p] [perfect_ring R p] [char_p S p] [perfect_ring S p]

@[simp] lemma coe_frobenius_equiv : ⇑(frobenius_equiv R p) = frobenius R p := rfl

@[simp] lemma coe_frobenius_equiv_symm : ⇑(frobenius_equiv R p).symm = pth_root R p := rfl

@[simp] theorem frobenius_pth_root (x : R) : frobenius R p (pth_root R p x) = x :=
(frobenius_equiv R p).apply_symm_apply x

@[simp] theorem pth_root_pow_p (x : R) : pth_root R p x ^ p = x :=
frobenius_pth_root x

@[simp] theorem pth_root_frobenius (x : R) : pth_root R p (frobenius R p x) = x :=
(frobenius_equiv R p).symm_apply_apply x

@[simp] theorem pth_root_pow_p' (x : R) : pth_root R p (x ^ p) = x :=
pth_root_frobenius x

theorem left_inverse_pth_root_frobenius : left_inverse (pth_root R p) (frobenius R p) :=
pth_root_frobenius

theorem right_inverse_pth_root_frobenius : function.right_inverse (pth_root R p) (frobenius R p) :=
frobenius_pth_root

theorem commute_frobenius_pth_root : function.commute (frobenius R p) (pth_root R p) :=
λ x, (frobenius_pth_root x).trans (pth_root_frobenius x).symm

theorem eq_pth_root_iff {x y : R} : x = pth_root R p y ↔ frobenius R p x = y :=
(frobenius_equiv R p).to_equiv.eq_symm_apply

theorem pth_root_eq_iff {x y : R} : pth_root R p x = y ↔ x = frobenius R p y :=
(frobenius_equiv R p).to_equiv.symm_apply_eq

theorem monoid_hom.map_pth_root (x : R) : f (pth_root R p x) = pth_root S p (f x) :=
eq_pth_root_iff.2 $ by rw [← f.map_frobenius, frobenius_pth_root]

theorem monoid_hom.map_iterate_pth_root (x : R) (n : ℕ) :
  f (pth_root R p^[n] x) = (pth_root S p^[n] (f x)) :=
semiconj.iterate_right f.map_pth_root n x

theorem ring_hom.map_pth_root (x : R) :
  g (pth_root R p x) = pth_root S p (g x) :=
g.to_monoid_hom.map_pth_root x

theorem ring_hom.map_iterate_pth_root (x : R) (n : ℕ) :
  g (pth_root R p^[n] x) = (pth_root S p^[n] (g x)) :=
g.to_monoid_hom.map_iterate_pth_root x n

variables (p)
lemma injective_pow_p {x y : R} (hxy : x ^ p = y ^ p) : x = y :=
left_inverse_pth_root_frobenius.injective hxy

end

section

variables (K : Type u) [comm_ring K] (p : ℕ) [fact p.prime] [char_p K p]

/-- `perfect_closure K p` is the quotient by this relation. -/
@[mk_iff] inductive perfect_closure.r : (ℕ × K) → (ℕ × K) → Prop
| intro : ∀ n x, perfect_closure.r (n, x) (n+1, frobenius K p x)

/-- The perfect closure is the smallest extension that makes frobenius surjective. -/
def perfect_closure : Type u := quot (perfect_closure.r K p)

end

namespace perfect_closure

variables (K : Type u)

section ring

variables [comm_ring K] (p : ℕ) [fact p.prime] [char_p K p]

/-- Constructor for `perfect_closure`. -/
def mk (x : ℕ × K) : perfect_closure K p := quot.mk (r K p) x

@[simp] lemma quot_mk_eq_mk (x : ℕ × K) :
  (quot.mk (r K p) x : perfect_closure K p) = mk K p x := rfl

variables {K p}

/-- Lift a function `ℕ × K → L` to a function on `perfect_closure K p`. -/
@[elab_as_eliminator]
def lift_on {L : Type*} (x : perfect_closure K p) (f : ℕ × K → L)
  (hf : ∀ x y, r K p x y → f x = f y) : L :=
quot.lift_on x f hf

@[simp] lemma lift_on_mk {L : Sort*} (f : ℕ × K → L)
  (hf : ∀ x y, r K p x y → f x = f y) (x : ℕ × K) :
  (mk K p x).lift_on f hf = f x :=
rfl

@[elab_as_eliminator]
lemma induction_on (x : perfect_closure K p) {q : perfect_closure K p → Prop}
  (h : ∀ x, q (mk K p x)) : q x :=
quot.induction_on x h

variables (K p)

private lemma mul_aux_left (x1 x2 y : ℕ × K) (H : r K p x1 x2) :
  mk K p (x1.1 + y.1, ((frobenius K p)^[y.1] x1.2) * ((frobenius K p)^[x1.1] y.2)) =
  mk K p (x2.1 + y.1, ((frobenius K p)^[y.1] x2.2) * ((frobenius K p)^[x2.1] y.2)) :=
match x1, x2, H with
| _, _, r.intro n x := quot.sound $ by rw [← iterate_succ_apply, iterate_succ',
    iterate_succ', ← frobenius_mul, nat.succ_add]; apply r.intro
end

private lemma mul_aux_right (x y1 y2 : ℕ × K) (H : r K p y1 y2) :
  mk K p (x.1 + y1.1, ((frobenius K p)^[y1.1] x.2) * ((frobenius K p)^[x.1] y1.2)) =
  mk K p (x.1 + y2.1, ((frobenius K p)^[y2.1] x.2) * ((frobenius K p)^[x.1] y2.2)) :=
match y1, y2, H with
| _, _, r.intro n y := quot.sound $ by rw [← iterate_succ_apply, iterate_succ',
    iterate_succ', ← frobenius_mul]; apply r.intro
end

instance : has_mul (perfect_closure K p) :=
⟨quot.lift (λ x:ℕ×K, quot.lift (λ y:ℕ×K, mk K p
    (x.1 + y.1, ((frobenius K p)^[y.1] x.2) * ((frobenius K p)^[x.1] y.2))) (mul_aux_right K p x))
  (λ x1 x2 (H : r K p x1 x2), funext $ λ e, quot.induction_on e $ λ y,
mul_aux_left K p x1 x2 y H)⟩

@[simp] lemma mk_mul_mk (x y : ℕ × K) :
  mk K p x * mk K p y = mk K p
    (x.1 + y.1, ((frobenius K p)^[y.1] x.2) * ((frobenius K p)^[x.1] y.2)) :=
rfl

instance : comm_monoid (perfect_closure K p) :=
{ mul_assoc := λ e f g, quot.induction_on e $ λ ⟨m, x⟩, quot.induction_on f $ λ ⟨n, y⟩,
    quot.induction_on g $ λ ⟨s, z⟩, congr_arg (quot.mk _) $
    by simp only [add_assoc, mul_assoc, ring_hom.iterate_map_mul,
      ← iterate_add_apply, add_comm, add_left_comm],
  one := mk K p (0, 1),
  one_mul := λ e, quot.induction_on e (λ ⟨n, x⟩, congr_arg (quot.mk _) $
    by simp only [ring_hom.iterate_map_one, iterate_zero_apply, one_mul, zero_add]),
  mul_one := λ e, quot.induction_on e (λ ⟨n, x⟩, congr_arg (quot.mk _) $
    by simp only [ring_hom.iterate_map_one, iterate_zero_apply, mul_one, add_zero]),
  mul_comm := λ e f, quot.induction_on e (λ ⟨m, x⟩, quot.induction_on f (λ ⟨n, y⟩,
    congr_arg (quot.mk _) $ by simp only [add_comm, mul_comm])),
  .. (infer_instance : has_mul (perfect_closure K p)) }

lemma one_def : (1 : perfect_closure K p) = mk K p (0, 1) := rfl

instance : inhabited (perfect_closure K p) := ⟨1⟩

private lemma add_aux_left (x1 x2 y : ℕ × K) (H : r K p x1 x2) :
  mk K p (x1.1 + y.1, ((frobenius K p)^[y.1] x1.2) + ((frobenius K p)^[x1.1] y.2)) =
  mk K p (x2.1 + y.1, ((frobenius K p)^[y.1] x2.2) + ((frobenius K p)^[x2.1] y.2)) :=
match x1, x2, H with
| _, _, r.intro n x := quot.sound $ by rw [← iterate_succ_apply, iterate_succ',
    iterate_succ', ← frobenius_add, nat.succ_add]; apply r.intro
end

private lemma add_aux_right (x y1 y2 : ℕ × K) (H : r K p y1 y2) :
  mk K p (x.1 + y1.1, ((frobenius K p)^[y1.1] x.2) + ((frobenius K p)^[x.1] y1.2)) =
  mk K p (x.1 + y2.1, ((frobenius K p)^[y2.1] x.2) + ((frobenius K p)^[x.1] y2.2)) :=
match y1, y2, H with
| _, _, r.intro n y := quot.sound $ by rw [← iterate_succ_apply, iterate_succ',
    iterate_succ', ← frobenius_add]; apply r.intro
end

instance : has_add (perfect_closure K p) :=
⟨quot.lift (λ x:ℕ×K, quot.lift (λ y:ℕ×K, mk K p
    (x.1 + y.1, ((frobenius K p)^[y.1] x.2) + ((frobenius K p)^[x.1] y.2))) (add_aux_right K p x))
  (λ x1 x2 (H : r K p x1 x2), funext $ λ e, quot.induction_on e $ λ y,
add_aux_left K p x1 x2 y H)⟩

@[simp] lemma mk_add_mk (x y : ℕ × K) :
  mk K p x + mk K p y =
    mk K p (x.1 + y.1, ((frobenius K p)^[y.1] x.2) + ((frobenius K p)^[x.1] y.2)) := rfl

instance : has_neg (perfect_closure K p) :=
⟨quot.lift (λ x:ℕ×K, mk K p (x.1, -x.2)) (λ x y (H : r K p x y), match x, y, H with
| _, _, r.intro n x := quot.sound $ by rw ← frobenius_neg; apply r.intro
end)⟩

@[simp] lemma neg_mk (x : ℕ × K) : - mk K p x = mk K p (x.1, -x.2) := rfl

instance : has_zero (perfect_closure K p) := ⟨mk K p (0, 0)⟩

lemma zero_def : (0 : perfect_closure K p) = mk K p (0, 0) := rfl

theorem mk_zero (n : ℕ) : mk K p (n, 0) = 0 :=
by induction n with n ih; [refl, rw ← ih]; symmetry; apply quot.sound;
have := r.intro n (0:K); rwa [frobenius_zero K p] at this

theorem r.sound (m n : ℕ) (x y : K) (H : frobenius K p^[m] x = y) :
  mk K p (n, x) = mk K p (m + n, y) :=
by subst H; induction m with m ih; [simp only [zero_add, iterate_zero_apply],
  rw [ih, nat.succ_add, iterate_succ']]; apply quot.sound; apply r.intro

instance : comm_ring (perfect_closure K p) :=
{ add_assoc := λ e f g, quot.induction_on e $ λ ⟨m, x⟩, quot.induction_on f $ λ ⟨n, y⟩,
    quot.induction_on g $ λ ⟨s, z⟩, congr_arg (quot.mk _) $
    by simp only [ring_hom.iterate_map_add, ← iterate_add_apply, add_assoc, add_comm s _],
  zero := 0,
  zero_add := λ e, quot.induction_on e (λ ⟨n, x⟩, congr_arg (quot.mk _) $
    by simp only [ring_hom.iterate_map_zero, iterate_zero_apply, zero_add]),
  add_zero := λ e, quot.induction_on e (λ ⟨n, x⟩, congr_arg (quot.mk _) $
    by simp only [ring_hom.iterate_map_zero, iterate_zero_apply, add_zero]),
  sub_eq_add_neg := λ a b, rfl,
  add_left_neg := λ e, by exact quot.induction_on e (λ ⟨n, x⟩,
    by simp only [quot_mk_eq_mk, neg_mk, mk_add_mk,
      ring_hom.iterate_map_neg, add_left_neg, mk_zero]),
  add_comm := λ e f, quot.induction_on e (λ ⟨m, x⟩, quot.induction_on f (λ ⟨n, y⟩,
    congr_arg (quot.mk _) $ by simp only [add_comm])),
  left_distrib := λ e f g, quot.induction_on e $ λ ⟨m, x⟩, quot.induction_on f $ λ ⟨n, y⟩,
    quot.induction_on g $ λ ⟨s, z⟩, show quot.mk _ _ = quot.mk _ _,
    by simp only [add_assoc, add_comm, add_left_comm]; apply r.sound;
    simp only [ring_hom.iterate_map_mul, ring_hom.iterate_map_add,
      ← iterate_add_apply, mul_add, add_comm, add_left_comm],
  right_distrib := λ e f g, quot.induction_on e $ λ ⟨m, x⟩, quot.induction_on f $ λ ⟨n, y⟩,
    quot.induction_on g $ λ ⟨s, z⟩, show quot.mk _ _ = quot.mk _ _,
    by simp only [add_assoc, add_comm _ s, add_left_comm _ s]; apply r.sound;
    simp only [ring_hom.iterate_map_mul, ring_hom.iterate_map_add,
      ← iterate_add_apply, add_mul, add_comm, add_left_comm],
  .. (infer_instance : has_add (perfect_closure K p)),
  .. (infer_instance : has_neg (perfect_closure K p)),
  .. (infer_instance : comm_monoid (perfect_closure K p)) }

theorem eq_iff' (x y : ℕ × K) : mk K p x = mk K p y ↔
    ∃ z, (frobenius K p^[y.1 + z] x.2) = (frobenius K p^[x.1 + z] y.2) :=
begin
  split,
  { intro H,
    replace H := quot.exact _ H,
    induction H,
    case eqv_gen.rel : x y H
    { cases H with n x, exact ⟨0, rfl⟩ },
    case eqv_gen.refl : H
    { exact ⟨0, rfl⟩ },
    case eqv_gen.symm : x y H ih
    { cases ih with w ih, exact ⟨w, ih.symm⟩ },
    case eqv_gen.trans : x y z H1 H2 ih1 ih2
    { cases ih1 with z1 ih1,
      cases ih2 with z2 ih2,
      existsi z2+(y.1+z1),
      rw [← add_assoc, iterate_add_apply, ih1],
      rw [← iterate_add_apply, add_comm, iterate_add_apply, ih2],
      rw [← iterate_add_apply],
      simp only [add_comm, add_left_comm] } },
  intro H,
  cases x with m x,
  cases y with n y,
  cases H with z H, dsimp only at H,
  rw [r.sound K p (n+z) m x _ rfl, r.sound K p (m+z) n y _ rfl, H],
  rw [add_assoc, add_comm, add_comm z]
end

theorem nat_cast (n x : ℕ) : (x : perfect_closure K p) = mk K p (n, x) :=
begin
  induction n with n ih,
  { induction x with x ih, {refl},
    rw [nat.cast_succ, nat.cast_succ, ih], refl },
  rw ih, apply quot.sound,
  conv {congr, skip, skip, rw ← frobenius_nat_cast K p x},
  apply r.intro
end

theorem int_cast (x : ℤ) : (x : perfect_closure K p) = mk K p (0, x) :=
by induction x; simp only [int.cast_of_nat, int.cast_neg_succ_of_nat, nat_cast K p 0]; refl

instance : char_p (perfect_closure K p) p :=
begin
  constructor, intro x, rw ← char_p.cast_eq_zero_iff K,
  rw [← nat.cast_zero, nat_cast_eq_iff, nat.cast_zero]
end

theorem frobenius_mk (x : ℕ × K) :
  (frobenius (perfect_closure K p) p : perfect_closure K p → perfect_closure K p)
    (mk K p x) = mk _ _ (x.1, x.2^p) :=
begin
  simp only [frobenius_def], cases x with n x, dsimp only,
  suffices : ∀ p':ℕ, mk K p (n, x) ^ p' = mk K p (n, x ^ p'),
  { apply this },
  intro p, induction p with p ih,
  case nat.zero { apply r.sound, rw [(frobenius _ _).iterate_map_one, pow_zero] },
  case nat.succ
  { rw [pow_succ, ih],
    symmetry,
    apply r.sound,
    simp only [pow_succ, (frobenius _ _).iterate_map_mul] }
end

/-- Embedding of `K` into `perfect_closure K p` -/
def of : K →+* perfect_closure K p :=
{ to_fun := λ x, mk _ _ (0, x),
  map_one' := rfl,
  map_mul' := λ x y, rfl,
  map_zero' := rfl,
  map_add' := λ x y, rfl }

lemma of_apply (x : K) : of K p x = mk _ _ (0, x) := rfl

end ring

theorem eq_iff [comm_ring K] [is_domain K] (p : ℕ) [fact p.prime] [char_p K p]
  (x y : ℕ × K) : quot.mk (r K p) x = quot.mk (r K p) y ↔
    (frobenius K p^[y.1] x.2) = (frobenius K p^[x.1] y.2) :=
(eq_iff' K p x y).trans ⟨λ ⟨z, H⟩, (frobenius_inj K p).iterate z $
  by simpa only [add_comm, iterate_add] using H,
λ H, ⟨0, H⟩⟩

section field

variables [field K] (p : ℕ) [fact p.prime] [char_p K p]

instance : has_inv (perfect_closure K p) :=
⟨quot.lift (λ x:ℕ×K, quot.mk (r K p) (x.1, x.2⁻¹)) (λ x y (H : r K p x y), match x, y, H with
| _, _, r.intro n x := quot.sound $ by { simp only [frobenius_def], rw ← inv_pow₀, apply r.intro }
end)⟩

instance : field (perfect_closure K p) :=
{ exists_pair_ne := ⟨0, 1, λ H, zero_ne_one ((eq_iff _ _ _ _).1 H)⟩,
  mul_inv_cancel := λ e, induction_on e $ λ ⟨m, x⟩ H,
    have _ := mt (eq_iff _ _ _ _).2 H, (eq_iff _ _ _ _).2
      (by simp only [(frobenius _ _).iterate_map_one, (frobenius K p).iterate_map_zero,
        iterate_zero_apply, ← (frobenius _ p).iterate_map_mul] at this ⊢;
        rw [mul_inv_cancel this, (frobenius _ _).iterate_map_one]),
  inv_zero := congr_arg (quot.mk (r K p)) (by rw [inv_zero]),
  .. (infer_instance : has_inv (perfect_closure K p)),
  .. (infer_instance : comm_ring (perfect_closure K p)) }

instance : perfect_ring (perfect_closure K p) p :=
{ pth_root' := λ e, lift_on e (λ x, mk K p (x.1 + 1, x.2)) (λ x y H,
    match x, y, H with
    | _, _, r.intro n x := quot.sound (r.intro _ _)
    end),
  frobenius_pth_root' := λ e, induction_on e (λ ⟨n, x⟩,
    by { simp only [lift_on_mk, frobenius_mk], exact (quot.sound $ r.intro _ _).symm }),
  pth_root_frobenius' := λ e, induction_on e (λ ⟨n, x⟩,
    by { simp only [lift_on_mk, frobenius_mk], exact (quot.sound $ r.intro _ _).symm }) }

theorem eq_pth_root (x : ℕ × K) :
  mk K p x = (pth_root (perfect_closure K p) p^[x.1] (of K p x.2)) :=
begin
  rcases x with ⟨m, x⟩,
  induction m with m ih, {refl},
  rw [iterate_succ_apply', ← ih]; refl
end

/-- Given a field `K` of characteristic `p` and a perfect ring `L` of the same characteristic,
any homomorphism `K →+* L` can be lifted to `perfect_closure K p`. -/
def lift (L : Type v) [comm_semiring L] [char_p L p] [perfect_ring L p] :
  (K →+* L) ≃ (perfect_closure K p →+* L) :=
begin
  have := left_inverse_pth_root_frobenius.iterate,
  refine_struct { .. },
  field to_fun { intro f,
    refine_struct { .. },
    field to_fun { refine λ e, lift_on e (λ x, pth_root L p^[x.1] (f x.2)) _,
      rintro a b ⟨n⟩,
      simp only [f.map_frobenius, iterate_succ_apply, pth_root_frobenius] },
    field map_one' { exact f.map_one },
    field map_zero' { exact f.map_zero },
    field map_mul' { rintro ⟨x⟩ ⟨y⟩,
      simp only [quot_mk_eq_mk, lift_on_mk, mk_mul_mk, ring_hom.map_iterate_frobenius,
        ring_hom.iterate_map_mul, ring_hom.map_mul],
      rw [iterate_add_apply, this _ _, add_comm, iterate_add_apply, this _ _] },
    field map_add' { rintro ⟨x⟩ ⟨y⟩,
      simp only [quot_mk_eq_mk, lift_on_mk, mk_add_mk, ring_hom.map_iterate_frobenius,
        ring_hom.iterate_map_add, ring_hom.map_add],
      rw [iterate_add_apply, this _ _, add_comm x.1, iterate_add_apply, this _ _] } },
  field inv_fun { exact λ f, f.comp (of K p) },
  field left_inv { intro f, ext x, refl },
  field right_inv { intro f, ext ⟨x⟩,
    simp only [ring_hom.coe_mk, quot_mk_eq_mk, ring_hom.comp_apply, lift_on_mk],
    rw [eq_pth_root, ring_hom.map_iterate_pth_root] }
end

end field

end perfect_closure

/-- A reduced ring with prime characteristic and surjective frobenius map is perfect. -/
noncomputable def perfect_ring.of_surjective (k : Type*) [comm_ring k] [is_reduced k] (p : ℕ)
  [fact p.prime] [char_p k p] (h : function.surjective $ frobenius k p) :
  perfect_ring k p :=
{ pth_root' := function.surj_inv h,
  frobenius_pth_root' := function.surj_inv_eq h,
  pth_root_frobenius' := λ x, frobenius_inj _ _ $ function.surj_inv_eq h _ }


/-
Copyright (c) 2020 Adam Topaz. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Zhangir Azerbayev, Adam Topaz, Eric Wieser
-/

import algebra.ring_quot
import linear_algebra.tensor_algebra.basic
import linear_algebra.alternating
import group_theory.perm.sign

/-!
# Exterior Algebras

We construct the exterior algebra of a module `M` over a commutative semiring `R`.

## Notation

The exterior algebra of the `R`-module `M` is denoted as `exterior_algebra R M`.
It is endowed with the structure of an `R`-algebra.

Given a linear morphism `f : M → A` from a module `M` to another `R`-algebra `A`, such that
`cond : ∀ m : M, f m * f m = 0`, there is a (unique) lift of `f` to an `R`-algebra morphism,
which is denoted `exterior_algebra.lift R f cond`.

The canonical linear map `M → exterior_algebra R M` is denoted `exterior_algebra.ι R`.

## Theorems

The main theorems proved ensure that `exterior_algebra R M` satisfies the universal property
of the exterior algebra.
1. `ι_comp_lift` is  fact that the composition of `ι R` with `lift R f cond` agrees with `f`.
2. `lift_unique` ensures the uniqueness of `lift R f cond` with respect to 1.

## Definitions

* `ι_multi` is the `alternating_map` corresponding to the wedge product of `ι R m` terms.

## Implementation details

The exterior algebra of `M` is constructed as a quotient of the tensor algebra, as follows.
1. We define a relation `exterior_algebra.rel R M` on `tensor_algebra R M`.
   This is the smallest relation which identifies squares of elements of `M` with `0`.
2. The exterior algebra is the quotient of the tensor algebra by this relation.

-/

universes u1 u2 u3

variables (R : Type u1) [comm_semiring R]
variables (M : Type u2) [add_comm_monoid M] [module R M]

namespace exterior_algebra
open tensor_algebra

/-- `rel` relates each `ι m * ι m`, for `m : M`, with `0`.

The exterior algebra of `M` is defined as the quotient modulo this relation.
-/
inductive rel : tensor_algebra R M → tensor_algebra R M → Prop
| of (m : M) : rel ((ι R m) * (ι R m)) 0

end exterior_algebra

/--
The exterior algebra of an `R`-module `M`.
-/
@[derive [inhabited, semiring, algebra R]]
def exterior_algebra := ring_quot (exterior_algebra.rel R M)

namespace exterior_algebra

variables {M}

instance {S : Type u3} [comm_ring S] [module S M] : ring (exterior_algebra S M) :=
ring_quot.ring (exterior_algebra.rel S M)

/--
The canonical linear map `M →ₗ[R] exterior_algebra R M`.
-/
def ι : M →ₗ[R] exterior_algebra R M :=
(ring_quot.mk_alg_hom R _).to_linear_map.comp (tensor_algebra.ι R)

variables {R}

/-- As well as being linear, `ι m` squares to zero -/
@[simp]
theorem ι_sq_zero (m : M) : (ι R m) * (ι R m) = 0 :=
begin
  erw [←alg_hom.map_mul, ring_quot.mk_alg_hom_rel R (rel.of m), alg_hom.map_zero _],
end

variables {A : Type*} [semiring A] [algebra R A]

@[simp]
theorem comp_ι_sq_zero (g : exterior_algebra R M →ₐ[R] A)
  (m : M) : g (ι R m) * g (ι R m) = 0 :=
by rw [←alg_hom.map_mul, ι_sq_zero, alg_hom.map_zero]

variables (R)

/--
Given a linear map `f : M →ₗ[R] A` into an `R`-algebra `A`, which satisfies the condition:
`cond : ∀ m : M, f m * f m = 0`, this is the canonical lift of `f` to a morphism of `R`-algebras
from `exterior_algebra R M` to `A`.
-/
@[simps symm_apply]
def lift : {f : M →ₗ[R] A // ∀ m, f m * f m = 0} ≃ (exterior_algebra R M →ₐ[R] A) :=
{ to_fun := λ f,
  ring_quot.lift_alg_hom R ⟨tensor_algebra.lift R (f : M →ₗ[R] A),
    λ x y (h : rel R M x y), by
    { induction h,
      rw [alg_hom.map_zero, alg_hom.map_mul, tensor_algebra.lift_ι_apply, f.prop] }⟩,
  inv_fun := λ F, ⟨F.to_linear_map.comp (ι R), λ m, by rw [
    linear_map.comp_apply, alg_hom.to_linear_map_apply, comp_ι_sq_zero]⟩,
  left_inv := λ f, by { ext, simp [ι] },
  right_inv := λ F, by { ext, simp [ι] } }

@[simp]
theorem ι_comp_lift (f : M →ₗ[R] A) (cond : ∀ m, f m * f m = 0) :
  (lift R ⟨f, cond⟩).to_linear_map.comp (ι R) = f :=
(subtype.mk_eq_mk.mp $ (lift R).symm_apply_apply ⟨f, cond⟩)

@[simp]
theorem lift_ι_apply (f : M →ₗ[R] A) (cond : ∀ m, f m * f m = 0) (x) :
  lift R ⟨f, cond⟩ (ι R x) = f x :=
(linear_map.ext_iff.mp $ ι_comp_lift R f cond) x

@[simp]
theorem lift_unique (f : M →ₗ[R] A) (cond : ∀ m, f m * f m = 0)
  (g : exterior_algebra R M →ₐ[R] A) : g.to_linear_map.comp (ι R) = f ↔ g = lift R ⟨f, cond⟩ :=
begin
  convert (lift R).symm_apply_eq,
  rw lift_symm_apply,
  simp only,
end

attribute [irreducible] ι lift
-- Marking `exterior_algebra` irreducible makes our `ring` instances inaccessible.
-- https://leanprover.zulipchat.com/#narrow/stream/113488-general/topic/algebra.2Esemiring_to_ring.20breaks.20semimodule.20typeclass.20lookup/near/212580241
-- For now, we avoid this by not marking it irreducible.

variables {R M}

@[simp]
theorem lift_comp_ι (g : exterior_algebra R M →ₐ[R] A) :
  lift R ⟨g.to_linear_map.comp (ι R), comp_ι_sq_zero _⟩ = g :=
begin
  convert (lift R).apply_symm_apply g,
  rw lift_symm_apply,
  refl,
end

/-- See note [partially-applied ext lemmas]. -/
@[ext]
theorem hom_ext {f g : exterior_algebra R M →ₐ[R] A}
  (h : f.to_linear_map.comp (ι R) = g.to_linear_map.comp (ι R)) : f = g :=
begin
  apply (lift R).symm.injective,
  rw [lift_symm_apply, lift_symm_apply],
  simp only [h],
end

/-- If `C` holds for the `algebra_map` of `r : R` into `exterior_algebra R M`, the `ι` of `x : M`,
and is preserved under addition and muliplication, then it holds for all of `exterior_algebra R M`.
-/
-- This proof closely follows `tensor_algebra.induction`
@[elab_as_eliminator]
lemma induction {C : exterior_algebra R M → Prop}
  (h_grade0 : ∀ r, C (algebra_map R (exterior_algebra R M) r))
  (h_grade1 : ∀ x, C (ι R x))
  (h_mul : ∀ a b, C a → C b → C (a * b))
  (h_add : ∀ a b, C a → C b → C (a + b))
  (a : exterior_algebra R M) :
  C a :=
begin
  -- the arguments are enough to construct a subalgebra, and a mapping into it from M
  let s : subalgebra R (exterior_algebra R M) :=
  { carrier := C,
    mul_mem' := h_mul,
    add_mem' := h_add,
    algebra_map_mem' := h_grade0, },
  let of : { f : M →ₗ[R] s // ∀ m, f m * f m = 0 } :=
  ⟨(ι R).cod_restrict s.to_submodule h_grade1,
    λ m, subtype.eq $ ι_sq_zero m ⟩,
  -- the mapping through the subalgebra is the identity
  have of_id : alg_hom.id R (exterior_algebra R M) = s.val.comp (lift R of),
  { ext,
    simp [of], },
  -- finding a proof is finding an element of the subalgebra
  convert subtype.prop (lift R of a),
  exact alg_hom.congr_fun of_id a,
end

/-- The left-inverse of `algebra_map`. -/
def algebra_map_inv : exterior_algebra R M →ₐ[R] R :=
exterior_algebra.lift R ⟨(0 : M →ₗ[R] R), λ m, by simp⟩

variables (M)

lemma algebra_map_left_inverse :
  function.left_inverse algebra_map_inv (algebra_map R $ exterior_algebra R M) :=
λ x, by simp [algebra_map_inv]

@[simp] lemma algebra_map_inj (x y : R) :
  algebra_map R (exterior_algebra R M) x = algebra_map R (exterior_algebra R M) y ↔ x = y :=
(algebra_map_left_inverse M).injective.eq_iff

@[simp] lemma algebra_map_eq_zero_iff (x : R) :
  algebra_map R (exterior_algebra R M) x = 0 ↔ x = 0 :=
map_eq_zero_iff (algebra_map _ _) (algebra_map_left_inverse _).injective

@[simp] lemma algebra_map_eq_one_iff (x : R) : algebra_map R (exterior_algebra R M) x = 1 ↔ x = 1 :=
map_eq_one_iff (algebra_map _ _) (algebra_map_left_inverse _).injective

variables {M}

/-- The canonical map from `exterior_algebra R M` into `triv_sq_zero_ext R M` that sends
`exterior_algebra.ι` to `triv_sq_zero_ext.inr`. -/
def to_triv_sq_zero_ext : exterior_algebra R M →ₐ[R] triv_sq_zero_ext R M :=
lift R ⟨triv_sq_zero_ext.inr_hom R M, λ m, triv_sq_zero_ext.inr_mul_inr R m m⟩

@[simp] lemma to_triv_sq_zero_ext_ι (x : M) :
  to_triv_sq_zero_ext (ι R x) = triv_sq_zero_ext.inr x :=
lift_ι_apply _ _ _ _

/-- The left-inverse of `ι`.

As an implementation detail, we implement this using `triv_sq_zero_ext` which has a suitable
algebra structure. -/
def ι_inv : exterior_algebra R M →ₗ[R] M :=
(triv_sq_zero_ext.snd_hom R M).comp to_triv_sq_zero_ext.to_linear_map

lemma ι_left_inverse : function.left_inverse ι_inv (ι R : M → exterior_algebra R M) :=
λ x, by simp [ι_inv]

variables (R)

@[simp] lemma ι_inj (x y : M) : ι R x = ι R y ↔ x = y :=
ι_left_inverse.injective.eq_iff

variables {R}

@[simp] lemma ι_eq_zero_iff (x : M) : ι R x = 0 ↔ x = 0 :=
by rw [←ι_inj R x 0, linear_map.map_zero]

@[simp] lemma ι_eq_algebra_map_iff (x : M) (r : R) : ι R x = algebra_map R _ r ↔ x = 0 ∧ r = 0 :=
begin
  refine ⟨λ h, _, _⟩,
  { have hf0 : to_triv_sq_zero_ext (ι R x) = (0, x), from to_triv_sq_zero_ext_ι _,
    rw [h, alg_hom.commutes] at hf0,
    have : r = 0 ∧ 0 = x := prod.ext_iff.1 hf0,
    exact this.symm.imp_left eq.symm, },
  { rintro ⟨rfl, rfl⟩,
    rw [linear_map.map_zero, ring_hom.map_zero] }
end

@[simp] lemma ι_ne_one [nontrivial R] (x : M) : ι R x ≠ 1 :=
begin
  rw [←(algebra_map R (exterior_algebra R M)).map_one, ne.def, ι_eq_algebra_map_iff],
  exact one_ne_zero ∘ and.right,
end

/-- The generators of the exterior algebra are disjoint from its scalars. -/
lemma ι_range_disjoint_one : disjoint (ι R).range (1 : submodule R (exterior_algebra R M)) :=
begin
  rw submodule.disjoint_def,
  rintros _ ⟨x, hx⟩ ⟨r, (rfl : algebra_map _ _ _ = _)⟩,
  rw ι_eq_algebra_map_iff x at hx,
  rw [hx.2, ring_hom.map_zero]
end

@[simp]
lemma ι_add_mul_swap (x y : M) : ι R x * ι R y + ι R y * ι R x = 0 :=
calc _ = ι R (x + y) * ι R (x + y) : by simp [mul_add, add_mul]
   ... = _ : ι_sq_zero _

lemma ι_mul_prod_list {n : ℕ} (f : fin n → M) (i : fin n) :
  (ι R $ f i) * (list.of_fn $ λ i, ι R $ f i).prod = 0 :=
begin
  induction n with n hn,
  { exact i.elim0, },
  { rw [list.of_fn_succ, list.prod_cons, ←mul_assoc],
    by_cases h : i = 0,
    { rw [h, ι_sq_zero, zero_mul], },
    { replace hn := congr_arg ((*) $ ι R $ f 0) (hn (λ i, f $ fin.succ i) (i.pred h)),
      simp only at hn,
      rw [fin.succ_pred, ←mul_assoc, mul_zero] at hn,
      refine (eq_zero_iff_eq_zero_of_add_eq_zero _).mp hn,
      rw [← add_mul, ι_add_mul_swap, zero_mul], } }
end

variables (R)
/-- The product of `n` terms of the form `ι R m` is an alternating map.

This is a special case of `multilinear_map.mk_pi_algebra_fin` -/
def ι_multi (n : ℕ) :
  alternating_map R M (exterior_algebra R M) (fin n) :=
let F := (multilinear_map.mk_pi_algebra_fin R n (exterior_algebra R M)).comp_linear_map (λ i, ι R)
in
{ map_eq_zero_of_eq' := λ f x y hfxy hxy, begin
    rw [multilinear_map.comp_linear_map_apply, multilinear_map.mk_pi_algebra_fin_apply],
    wlog h : x < y := lt_or_gt_of_ne hxy using x y,
    clear hxy,
    induction n with n hn generalizing x y,
    { exact x.elim0, },
    { rw [list.of_fn_succ, list.prod_cons],
      by_cases hx : x = 0,
      -- one of the repeated terms is on the left
      { rw hx at hfxy h,
        rw [hfxy, ←fin.succ_pred y (ne_of_lt h).symm],
        exact ι_mul_prod_list (f ∘ fin.succ) _, },
      -- ignore the left-most term and induct on the remaining ones, decrementing indices
      { convert mul_zero _,
        refine hn (λ i, f $ fin.succ i)
          (x.pred hx) (y.pred (ne_of_lt $ lt_of_le_of_lt x.zero_le h).symm)
          (fin.pred_lt_pred_iff.mpr h) _,
        simp only [fin.succ_pred],
        exact hfxy, } }
  end,
  to_fun := F, ..F}
variables {R}

lemma ι_multi_apply {n : ℕ} (v : fin n → M) :
  ι_multi R n v = (list.of_fn $ λ i, ι R (v i)).prod := rfl

end exterior_algebra

namespace tensor_algebra

variables {R M}

/-- The canonical image of the `tensor_algebra` in the `exterior_algebra`, which maps
`tensor_algebra.ι R x` to `exterior_algebra.ι R x`. -/
def to_exterior : tensor_algebra R M →ₐ[R] exterior_algebra R M :=
tensor_algebra.lift R (exterior_algebra.ι R)

@[simp] lemma to_exterior_ι (m : M) : (tensor_algebra.ι R m).to_exterior = exterior_algebra.ι R m :=
by simp [to_exterior]

end tensor_algebra


namespace prop_01

variables A B : Prop

theorem prop_1 : A ∧ (A → B) → B :=
assume h1 : A ∧ (A → B),
show B, from
    (have h2: A → B, from and.right h1,
     have h3: A, from and.left h1,
     show B, from h2 h3)

-- end namespace
end prop_01


/-
Copyright (c) 2022 Thomas Browning. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Thomas Browning
-/
import topology.is_locally_homeomorph
import topology.fiber_bundle.basic

/-!
# Covering Maps

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

This file defines covering maps.

## Main definitions

* `is_evenly_covered f x I`: A point `x` is evenly coverd by `f : E → X` with fiber `I` if `I` is
  discrete and there is a `trivialization` of `f` at `x` with fiber `I`.
* `is_covering_map f`: A function `f : E → X` is a covering map if every point `x` is evenly
  covered by `f` with fiber `f ⁻¹' {x}`. The fibers `f ⁻¹' {x}` must be discrete, but if `X` is
  not connected, then the fibers `f ⁻¹' {x}` are not necessarily isomorphic. Also, `f` is not
  assumed to be surjective, so the fibers are even allowed to be empty.
-/

open_locale bundle

variables {E X : Type*} [topological_space E] [topological_space X] (f : E → X) (s : set X)

/-- A point `x : X` is evenly covered by `f : E → X` if `x` has an evenly covered neighborhood. -/
def is_evenly_covered (x : X) (I : Type*) [topological_space I] :=
discrete_topology I ∧ ∃ t : trivialization I f, x ∈ t.base_set

namespace is_evenly_covered

variables {f}

/-- If `x` is evenly covered by `f`, then we can construct a trivialization of `f` at `x`. -/
noncomputable def to_trivialization {x : X} {I : Type*} [topological_space I]
  (h : is_evenly_covered f x I) : trivialization (f ⁻¹' {x}) f :=
(classical.some h.2).trans_fiber_homeomorph ((classical.some h.2).preimage_singleton_homeomorph
  (classical.some_spec h.2)).symm

lemma mem_to_trivialization_base_set {x : X} {I : Type*} [topological_space I]
  (h : is_evenly_covered f x I) : x ∈ h.to_trivialization.base_set :=
classical.some_spec h.2

lemma to_trivialization_apply {x : E} {I : Type*} [topological_space I]
  (h : is_evenly_covered f (f x) I) : (h.to_trivialization x).2 = ⟨x, rfl⟩ :=
let e := classical.some h.2, h := classical.some_spec h.2, he := e.mk_proj_snd' h in
  subtype.ext ((e.to_local_equiv.eq_symm_apply (e.mem_source.mpr h)
    (by rwa [he, e.mem_target, e.coe_fst (e.mem_source.mpr h)])).mpr he.symm).symm

protected lemma continuous_at {x : E} {I : Type*} [topological_space I]
  (h : is_evenly_covered f (f x) I) : continuous_at f x :=
let e := h.to_trivialization in
  e.continuous_at_proj (e.mem_source.mpr (mem_to_trivialization_base_set h))

lemma to_is_evenly_covered_preimage {x : X} {I : Type*} [topological_space I]
  (h : is_evenly_covered f x I) : is_evenly_covered f x (f ⁻¹' {x}) :=
let ⟨h1, h2⟩ := h in by exactI ⟨((classical.some h2).preimage_singleton_homeomorph
  (classical.some_spec h2)).embedding.discrete_topology, _, h.mem_to_trivialization_base_set⟩

end is_evenly_covered

/-- A covering map is a continuous function `f : E → X` with discrete fibers such that each point
  of `X` has an evenly covered neighborhood. -/
def is_covering_map_on :=
∀ x ∈ s, is_evenly_covered f x (f ⁻¹' {x})

namespace is_covering_map_on

lemma mk (F : X → Type*) [Π x, topological_space (F x)] [hF : Π x, discrete_topology (F x)]
  (e : Π x ∈ s, trivialization (F x) f) (h : ∀ (x : X) (hx : x ∈ s), x ∈ (e x hx).base_set) :
  is_covering_map_on f s :=
λ x hx, is_evenly_covered.to_is_evenly_covered_preimage ⟨hF x, e x hx, h x hx⟩

variables {f} {s}

protected lemma continuous_at (hf : is_covering_map_on f s) {x : E} (hx : f x ∈ s) :
  continuous_at f x :=
(hf (f x) hx).continuous_at

protected lemma continuous_on (hf : is_covering_map_on f s) : continuous_on f (f ⁻¹' s) :=
continuous_at.continuous_on (λ x, hf.continuous_at)

protected lemma is_locally_homeomorph_on (hf : is_covering_map_on f s) :
  is_locally_homeomorph_on f (f ⁻¹' s) :=
begin
  refine is_locally_homeomorph_on.mk f (f ⁻¹' s) (λ x hx, _),
  let e := (hf (f x) hx).to_trivialization,
  have h := (hf (f x) hx).mem_to_trivialization_base_set,
  let he := e.mem_source.2 h,
  refine ⟨e.to_local_homeomorph.trans
  { to_fun := λ p, p.1,
    inv_fun := λ p, ⟨p, x, rfl⟩,
    source := e.base_set ×ˢ ({⟨x, rfl⟩} : set (f ⁻¹' {f x})),
    target := e.base_set,
    open_source := e.open_base_set.prod (singletons_open_iff_discrete.2 (hf (f x) hx).1 ⟨x, rfl⟩),
    open_target := e.open_base_set,
    map_source' := λ p, and.left,
    map_target' := λ p hp, ⟨hp, rfl⟩,
    left_inv' := λ p hp, prod.ext rfl hp.2.symm,
    right_inv' := λ p hp, rfl,
    continuous_to_fun := continuous_fst.continuous_on,
    continuous_inv_fun := (continuous_id'.prod_mk continuous_const).continuous_on },
    ⟨he, by rwa [e.to_local_homeomorph.symm_symm, e.proj_to_fun x he],
      (hf (f x) hx).to_trivialization_apply⟩, λ p h, (e.proj_to_fun p h.1).symm⟩,
end

end is_covering_map_on

/-- A covering map is a continuous function `f : E → X` with discrete fibers such that each point
  of `X` has an evenly covered neighborhood. -/
def is_covering_map :=
∀ x, is_evenly_covered f x (f ⁻¹' {x})

variables {f}

lemma is_covering_map_iff_is_covering_map_on_univ :
  is_covering_map f ↔ is_covering_map_on f set.univ :=
by simp only [is_covering_map, is_covering_map_on, set.mem_univ, forall_true_left]

protected lemma is_covering_map.is_covering_map_on (hf : is_covering_map f) :
  is_covering_map_on f set.univ :=
is_covering_map_iff_is_covering_map_on_univ.mp hf

variables (f)

namespace is_covering_map

lemma mk (F : X → Type*) [Π x, topological_space (F x)] [hF : Π x, discrete_topology (F x)]
  (e : Π x, trivialization (F x) f) (h : ∀ x, x ∈ (e x).base_set) : is_covering_map f :=
is_covering_map_iff_is_covering_map_on_univ.mpr
  (is_covering_map_on.mk f set.univ F (λ x hx, e x) (λ x hx, h x))

variables {f}

protected lemma continuous (hf : is_covering_map f) : continuous f :=
continuous_iff_continuous_on_univ.mpr hf.is_covering_map_on.continuous_on

protected lemma is_locally_homeomorph (hf : is_covering_map f) : is_locally_homeomorph f :=
is_locally_homeomorph_iff_is_locally_homeomorph_on_univ.mpr
  hf.is_covering_map_on.is_locally_homeomorph_on

protected

protected lemma quotient_map (hf : is_covering_map f) (hf' : function.surjective f) :
  quotient_map f :=
hf.is_open_map.to_quotient_map hf.continuous hf'

end is_covering_map

variables {f}

protected lemma is_fiber_bundle.is_covering_map {F : Type*} [topological_space F]
  [discrete_topology F] (hf : ∀ x : X, ∃ e : trivialization F f, x ∈ e.base_set) :
  is_covering_map f :=
is_covering_map.mk f (λ x, F) (λ x, classical.some (hf x)) (λ x, classical.some_spec (hf x))

protected lemma fiber_bundle.is_covering_map {F : Type*} {E : X → Type*} [topological_space F]
  [discrete_topology F] [topological_space (bundle.total_space E)] [Π x, topological_space (E x)]
  [hf : fiber_bundle F E] : is_covering_map (π E) :=
is_fiber_bundle.is_covering_map
  (λ x, ⟨trivialization_at F E x, mem_base_set_trivialization_at F E x ⟩)


-- https://leanprover-community.github.io/mathlib_docs/category_theory/functor/hom.html
-- THE PLAN IS TO DEFINE AN AFFINE GROUP SCHEME AS A REPRESENTABLE FUNCTOR FROM K-ALGEBRAS TO GROUPS, AND PROVE THAT G_a := Hom(K[X], _) IS AN AFFINE GROUP SCHEME

import category_theory.types
import algebra.category.Algebra.basic
import algebra.category.Group.basic
import data.polynomial.basic
import data.polynomial.algebra_map
import category_theory.over
import tactic

open_locale polynomial
open polynomial
open category_theory

variables (K : Type*) [comm_ring K]
-- variables (K_alg : Type*) [category K_alg] [category_theory.under K] -- category of commutative K-algebras. But how to use it...

class affine_scheme :=
(scheme : Algebra K ⥤ Type*)
(corepresentable : scheme.corepresentable)

class affine_group_scheme :=
(scheme : Algebra K ⥤ Group)
(corepresentable : (scheme ⋙ forget Group).corepresentable)

example : ∃ (f : coyoneda.obj (opposite.op (Algebra.of K K[X])) ⟶ forget (Algebra K)), is_iso f :=
begin

end

-- DEFINING G_a
instance G_a : affine_scheme K :=
{
  scheme := forget (Algebra K),
  corepresentable := begin
    refine {has_corepresentation := _},
    refine ⟨opposite.op (Algebra.of K K[X]), _⟩,
    -- need to contruct a natural tranformation Hom(K[X], _) ⟶ forget (Algebra K)
    -- see for an example of defining a natural transformation https://leanprover-community.github.io/mathlib_docs/category_theory/yoneda.html#category_theory.yoneda_lemma
  end,
}

#check Algebra.of K K[X]
#check polynomial K