/-
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
-/

import data.mv_polynomial
import linear_algebra.dimension
import linear_algebra.direct_sum.finsupp
import linear_algebra.finite_dimensional

/-!
# Linear structures on function with finite support `ι →₀ M`

This file contains results on the `R`-module structure on functions of finite support from a type
`ι` to an `R`-module `M`, in particular in the case that `R` is a field.

Furthermore, it contains some facts about isomorphisms of vector spaces from equality of dimension
as well as the cardinality of finite dimensional vector spaces.

## TODO

Move the second half of this file to more appropriate other files.
-/

noncomputable theory
local attribute [instance, priority 100] classical.prop_decidable

open set linear_map submodule

namespace finsupp

section ring
variables {R : Type*} {M : Type*} {ι : Type*}
variables [ring R] [add_comm_group M] [module R M]

lemma linear_independent_single {φ : ι → Type*}
  {f : Π ι, φ ι → M} (hf : ∀i, linear_independent R (f i)) :
  linear_independent R (λ ix : Σ i, φ i, single ix.1 (f ix.1 ix.2)) :=
begin
  apply @linear_independent_Union_finite R _ _ _ _ ι φ (λ i x, single i (f i x)),
  { assume i,
    have h_disjoint : disjoint (span R (range (f i))) (ker (lsingle i)),
    { rw ker_lsingle,
      exact disjoint_bot_right },
    apply (hf i).map h_disjoint },
  { intros i t ht hit,
    refine (disjoint_lsingle_lsingle {i} t (disjoint_singleton_left.2 hit)).mono _ _,
    { rw span_le,
      simp only [supr_singleton],
      rw range_coe,
      apply range_comp_subset_range },
    { refine supr_le_supr (λ i, supr_le_supr _),
      intros hi,
      rw span_le,
      rw range_coe,
      apply range_comp_subset_range } }
end

open linear_map submodule

lemma is_basis_single {φ : ι → Type*} (f : Π ι, φ ι → M)
  (hf : ∀i, is_basis R (f i)) :
  is_basis R (λ ix : Σ i, φ i, single ix.1 (f ix.1 ix.2)) :=
begin
  split,
  { apply linear_independent_single,
    exact λ i, (hf i).1 },
  { rw [range_sigma_eq_Union_range, span_Union],
    simp only [image_univ.symm, λ i, image_comp (single i) (f i), span_single_image],
    simp only [image_univ, (hf _).2, map_top, supr_lsingle_range] }
end

lemma is_basis_single_one : is_basis R (λ i : ι, single i (1 : R)) :=
by convert (is_basis_single (λ (i : ι) (x : unit), (1 : R)) (λ i, is_basis_singleton_one R)).comp
  (λ i : ι, ⟨i, ()⟩) ⟨λ _ _, and.left ∘ sigma.mk.inj, λ ⟨i, ⟨⟩⟩, ⟨i, rfl⟩⟩

end ring

section comm_ring
variables {R : Type*} {M : Type*} {N : Type*} {ι : Type*} {κ : Type*}
variables [comm_ring R] [add_comm_group M] [module R M] [add_comm_group N] [module R N]

/-- If b : ι → M and c : κ → N are bases then so is λ i, b i.1 ⊗ₜ c i.2 : ι × κ → M ⊗ N. -/
lemma is_basis.tensor_product {b : ι → M} (hb : is_basis R b) {c : κ → N} (hc : is_basis R c) :
  is_basis R (λ i : ι × κ, b i.1 ⊗ₜ[R] c i.2) :=
by { convert linear_equiv.is_basis is_basis_single_one
  ((tensor_product.congr (module_equiv_finsupp hb) (module_equiv_finsupp hc)).trans $
    (finsupp_tensor_finsupp _ _ _ _ _).trans $
    lcongr (equiv.refl _) (tensor_product.lid R R)).symm,
  ext ⟨i, k⟩, rw [function.comp_apply, linear_equiv.eq_symm_apply], simp }

end comm_ring

section dim
universes u v
variables {K : Type u} {V : Type v} {ι : Type v}
variables [field K] [add_comm_group V] [module K V]

lemma dim_eq : module.rank K (ι →₀ V) = cardinal.mk ι * module.rank K V :=
begin
  rcases exists_is_basis K V with ⟨bs, hbs⟩,
  rw [← cardinal.lift_inj, cardinal.lift_mul, ← hbs.mk_eq_dim,
      ← (is_basis_single _ (λa:ι, hbs)).mk_eq_dim, ← cardinal.sum_mk,
      ← cardinal.lift_mul, cardinal.lift_inj],
  { simp only [cardinal.mk_image_eq (single_injective.{u u} _), cardinal.sum_const] }
end

end dim

end finsupp

section module
/- We use `universe variables` instead of `universes` here because universes introduced by the
   `universes` keyword do not get replaced by metavariables once a lemma has been proven. So if you
   prove a lemma using universe `u`, you can only apply it to universe `u` in other lemmas of the
   same section. -/
universe variables u v w
variables {K : Type u} {V V₁ V₂ : Type v} {V' : Type w}
variables [field K]
variables [add_comm_group V] [module K V]
variables [add_comm_group V₁] [module K V₁]
variables [add_comm_group V₂] [module K V₂]
variables [add_comm_group V'] [module K V']

open module

lemma equiv_of_dim_eq_lift_dim
  (h : cardinal.lift.{v w} (module.rank K V) = cardinal.lift.{w v} (module.rank K V')) :
  nonempty (V ≃ₗ[K] V') :=
begin
  haveI := classical.dec_eq V,
  haveI := classical.dec_eq V',
  rcases exists_is_basis K V with ⟨m, hm⟩,
  rcases exists_is_basis K V' with ⟨m', hm'⟩,
  rw [←cardinal.lift_inj.1 hm.mk_eq_dim, ←cardinal.lift_inj.1 hm'.mk_eq_dim] at h,
  rcases quotient.exact h with ⟨e⟩,
  let e := (equiv.ulift.symm.trans e).trans equiv.ulift,
  exact ⟨((module_equiv_finsupp hm).trans
      (finsupp.dom_lcongr e)).trans
      (module_equiv_finsupp hm').symm⟩,
end

/-- Two `K`-vector spaces are equivalent if their dimension is the same. -/
def equiv_of_dim_eq_dim (h : module.rank K V₁ = module.rank K V₂) : V₁ ≃ₗ[K] V₂ :=
begin
  classical,
  exact classical.choice (equiv_of_dim_eq_lift_dim (cardinal.lift_inj.2 h))
end

/-- An `n`-dimensional `K`-vector space is equivalent to `fin n → K`. -/
def fin_dim_vectorspace_equiv (n : ℕ)
  (hn : (module.rank K V) = n) : V ≃ₗ[K] (fin n → K) :=
begin
  have : cardinal.lift.{v u} (n : cardinal.{v}) = cardinal.lift.{u v} (n : cardinal.{u}),
    by simp,
  have hn := cardinal.lift_inj.{v u}.2 hn,
  rw this at hn,
  rw ←@dim_fin_fun K _ n at hn,
  exact classical.choice (equiv_of_dim_eq_lift_dim hn),
end

end module

section module
universes u

open module

variables (K V : Type u) [field K] [add_comm_group V] [module K V]

lemma cardinal_mk_eq_cardinal_mk_field_pow_dim [finite_dimensional K V] :
  cardinal.mk V = cardinal.mk K ^ module.rank K V :=
begin
  rcases exists_is_basis K V with ⟨s, hs⟩,
  have : nonempty (fintype s),
  { rw [← cardinal.lt_omega_iff_fintype, cardinal.lift_inj.1 hs.mk_eq_dim],
    exact finite_dimensional.dim_lt_omega K V },
  cases this with hsf, letI := hsf,
  calc cardinal.mk V = cardinal.mk (s →₀ K) : quotient.sound ⟨(module_equiv_finsupp hs).to_equiv⟩
    ... = cardinal.mk (s → K) : quotient.sound ⟨finsupp.equiv_fun_on_fintype⟩
    ... = _ : by rw [← cardinal.lift_inj.1 hs.mk_eq_dim, cardinal.power_def]
end

lemma cardinal_lt_omega_of_finite_dimensional [fintype K] [finite_dimensional K V] :
  cardinal.mk V < cardinal.omega :=
begin
  rw cardinal_mk_eq_cardinal_mk_field_pow_dim K V,
  exact cardinal.power_lt_omega (cardinal.lt_omega_iff_fintype.2 ⟨infer_instance⟩)
    (finite_dimensional.dim_lt_omega K V),
end

end module


/-
Copyright (c) 2019 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Markus Himmel
-/
import category_theory.limits.shapes.zero

/-!
# Kernels and cokernels

In a category with zero morphisms, the kernel of a morphism `f : X ⟶ Y` is
the equalizer of `f` and `0 : X ⟶ Y`. (Similarly the cokernel is the coequalizer.)

The basic definitions are
* `kernel : (X ⟶ Y) → C`
* `kernel.ι : kernel f ⟶ X`
* `kernel.condition : kernel.ι f ≫ f = 0` and
* `kernel.lift (k : W ⟶ X) (h : k ≫ f = 0) : W ⟶ kernel f` (as well as the dual versions)

## Main statements

Besides the definition and lifts, we prove
* `kernel.ι_zero_is_iso`: a kernel map of a zero morphism is an isomorphism
* `kernel.eq_zero_of_epi_kernel`: if `kernel.ι f` is an epimorphism, then `f = 0`
* `kernel.of_mono`: the kernel of a monomorphism is the zero object
* `kernel.lift_mono`: the lift of a monomorphism `k : W ⟶ X` such that `k ≫ f = 0`
  is still a monomorphism
* `kernel.is_limit_cone_zero_cone`: if our category has a zero object, then the map from the zero
  obect is a kernel map of any monomorphism
* `kernel.ι_of_zero`: `kernel.ι (0 : X ⟶ Y)` is an isomorphism

and the corresponding dual statements.

## Future work
* TODO: connect this with existing working in the group theory and ring theory libraries.

## Implementation notes
As with the other special shapes in the limits library, all the definitions here are given as
`abbreviation`s of the general statements for limits, so all the `simp` lemmas and theorems about
general limits can be used.

## References

* [F. Borceux, *Handbook of Categorical Algebra 2*][borceux-vol2]
-/

noncomputable theory

universes v u u'

open category_theory
open category_theory.limits.walking_parallel_pair

namespace category_theory.limits

variables {C : Type u} [category.{v} C]
variables [has_zero_morphisms C]

/-- A morphism `f` has a kernel if the functor `parallel_pair f 0` has a limit. -/
abbreviation has_kernel {X Y : C} (f : X ⟶ Y) : Prop := has_limit (parallel_pair f 0)
/-- A morphism `f` has a cokernel if the functor `parallel_pair f 0` has a colimit. -/
abbreviation has_cokernel {X Y : C} (f : X ⟶ Y) : Prop := has_colimit (parallel_pair f 0)

variables {X Y : C} (f : X ⟶ Y)

section

/-- A kernel fork is just a fork where the second morphism is a zero morphism. -/
abbreviation kernel_fork := fork f 0

variables {f}

@[simp, reassoc] lemma kernel_fork.condition (s : kernel_fork f) : fork.ι s ≫ f = 0 :=
by erw [fork.condition, has_zero_morphisms.comp_zero]

@[simp] lemma kernel_fork.app_one (s : kernel_fork f) : s.π.app one = 0 :=
by rw [←fork.app_zero_left, kernel_fork.condition]

/-- A morphism `ι` satisfying `ι ≫ f = 0` determines a kernel fork over `f`. -/
abbreviation kernel_fork.of_ι {Z : C} (ι : Z ⟶ X) (w : ι ≫ f = 0) : kernel_fork f :=
fork.of_ι ι $ by rw [w, has_zero_morphisms.comp_zero]

@[simp] lemma kernel_fork.ι_of_ι {X Y P : C} (f : X ⟶ Y) (ι : P ⟶ X) (w : ι ≫ f = 0) :
  fork.ι (kernel_fork.of_ι ι w) = ι := rfl

section
local attribute [tidy] tactic.case_bash

/-- Every kernel fork `s` is isomorphic (actually, equal) to `fork.of_ι (fork.ι s) _`. -/
def iso_of_ι (s : fork f 0) : s ≅ fork.of_ι (fork.ι s) (fork.condition s) :=
cones.ext (iso.refl _) $ by tidy

/-- If `ι = ι'`, then `fork.of_ι ι _` and `fork.of_ι ι' _` are isomorphic. -/
def of_ι_congr {P : C} {ι ι' : P ⟶ X} {w : ι ≫ f = 0} (h : ι = ι') :
  kernel_fork.of_ι ι w ≅ kernel_fork.of_ι ι' (by rw [←h, w]) :=
cones.ext (iso.refl _) $ by tidy

/-- If `F` is an equivalence, then applying `F` to a diagram indexing a (co)kernel of `f` yields
    the diagram indexing the (co)kernel of `F.map f`. -/
def comp_nat_iso {D : Type u'} [category.{v} D] [has_zero_morphisms D] (F : C ⥤ D)
  [is_equivalence F] : parallel_pair f 0 ⋙ F ≅ parallel_pair (F.map f) 0 :=
nat_iso.of_components (λ j, match j with
  | zero := iso.refl _
  | one := iso.refl _
  end) $ by tidy

end

/-- If `s` is a limit kernel fork and `k : W ⟶ X` satisfies ``k ≫ f = 0`, then there is some
    `l : W ⟶ s.X` such that `l ≫ fork.ι s = k`. -/
def kernel_fork.is_limit.lift' {s : kernel_fork f} (hs : is_limit s) {W : C} (k : W ⟶ X)
  (h : k ≫ f = 0) : {l : W ⟶ s.X // l ≫ fork.ι s = k} :=
⟨hs.lift $ kernel_fork.of_ι _ h, hs.fac _ _⟩

/-- This is a slightly more convenient method to verify that a kernel fork is a limit cone. It
    only asks for a proof of facts that carry any mathematical content -/
def is_limit_aux (t : kernel_fork f)
  (lift : Π (s : kernel_fork f), s.X ⟶ t.X)
  (fac : ∀ (s : kernel_fork f), lift s ≫ t.ι = s.ι)
  (uniq : ∀ (s : kernel_fork f) (m : s.X ⟶ t.X) (w : m ≫ t.ι = s.ι), m = lift s) :
  is_limit t :=
{ lift := lift,
  fac' := λ s j, by { cases j, { exact fac s, }, { simp, }, },
  uniq' := λ s m w, uniq s m (w limits.walking_parallel_pair.zero), }

/--
This is a more convenient formulation to show that a `kernel_fork` constructed using
`kernel_fork.of_ι` is a limit cone.
-/
def is_limit.of_ι {W : C} (g : W ⟶ X) (eq : g ≫ f = 0)
  (lift : Π {W' : C} (g' : W' ⟶ X) (eq' : g' ≫ f = 0), W' ⟶ W)
  (fac : ∀ {W' : C} (g' : W' ⟶ X) (eq' : g' ≫ f = 0), lift g' eq' ≫ g = g')
  (uniq :
    ∀ {W' : C} (g' : W' ⟶ X) (eq' : g' ≫ f = 0) (m : W' ⟶ W) (w : m ≫ g = g'), m = lift g' eq') :
  is_limit (kernel_fork.of_ι g eq) :=
is_limit_aux _ (λ s, lift s.ι s.condition) (λ s, fac s.ι s.condition) (λ s, uniq s.ι s.condition)

end

section
variables [has_kernel f]

/-- The kernel of a morphism, expressed as the equalizer with the 0 morphism. -/
abbreviation kernel : C := equalizer f 0

/-- The map from `kernel f` into the source of `f`. -/
abbreviation kernel.ι : kernel f ⟶ X := equalizer.ι f 0

@[simp] lemma equalizer_as_kernel : equalizer.ι f 0 = kernel.ι f := rfl

@[simp, reassoc] lemma kernel.condition : kernel.ι f ≫ f = 0 :=
kernel_fork.condition _

/-- Given any morphism `k : W ⟶ X` satisfying `k ≫ f = 0`, `k` factors through `kernel.ι f`
    via `kernel.lift : W ⟶ kernel f`. -/
abbreviation kernel.lift {W : C} (k : W ⟶ X) (h : k ≫ f = 0) : W ⟶ kernel f :=
limit.lift (parallel_pair f 0) (kernel_fork.of_ι k h)

@[simp, reassoc]
lemma kernel.lift_ι {W : C} (k : W ⟶ X) (h : k ≫ f = 0) : kernel.lift f k h ≫ kernel.ι f = k :=
limit.lift_π _ _

@[simp]
lemma kernel.lift_zero {W : C} {h} : kernel.lift f (0 : W ⟶ X) h = 0 :=
by { ext, simp, }

instance kernel.lift_mono {W : C} (k : W ⟶ X) (h : k ≫ f = 0) [mono k] : mono (kernel.lift f k h) :=
⟨λ Z g g' w,
begin
  replace w := w =≫ kernel.ι f,
  simp only [category.assoc, kernel.lift_ι] at w,
  exact (cancel_mono k).1 w,
end⟩

/-- Any morphism `k : W ⟶ X` satisfying `k ≫ f = 0` induces a morphism `l : W ⟶ kernel f` such that
    `l ≫ kernel.ι f = k`. -/
def kernel.lift' {W : C} (k : W ⟶ X) (h : k ≫ f = 0) : {l : W ⟶ kernel f // l ≫ kernel.ι f = k} :=
⟨kernel.lift f k h, kernel.lift_ι _ _ _⟩

/-- Every kernel of the zero morphism is an isomorphism -/
instance kernel.ι_zero_is_iso : is_iso (kernel.ι (0 : X ⟶ Y)) :=
equalizer.ι_of_self _

lemma eq_zero_of_epi_kernel [epi (kernel.ι f)] : f = 0 :=
(cancel_epi (kernel.ι f)).1 (by simp)

/-- The kernel of a zero morphism is isomorphic to the source. -/
def kernel_zero_iso_source : kernel (0 : X ⟶ Y) ≅ X :=
equalizer.iso_source_of_self 0

@[simp] lemma kernel_zero_iso_source_hom :
  kernel_zero_iso_source.hom = kernel.ι (0 : X ⟶ Y) := rfl

@[simp] lemma kernel_zero_iso_source_inv :
  kernel_zero_iso_source.inv = kernel.lift (0 : X ⟶ Y) (𝟙 X) (by simp) :=
by { ext, simp [kernel_zero_iso_source], }

/-- If two morphisms are known to be equal, then their kernels are isomorphic. -/
def kernel_iso_of_eq {f g : X ⟶ Y} [has_kernel f] [has_kernel g] (h : f = g) :
  kernel f ≅ kernel g :=
has_limit.iso_of_nat_iso (by simp[h])

@[simp]
lemma kernel_iso_of_eq_refl {h : f = f} : kernel_iso_of_eq h = iso.refl (kernel f) :=
by { ext, simp [kernel_iso_of_eq], }

@[simp]
lemma kernel_iso_of_eq_trans {f g h : X ⟶ Y} [has_kernel f] [has_kernel g] [has_kernel h]
  (w₁ : f = g) (w₂ : g = h) :
  kernel_iso_of_eq w₁ ≪≫ kernel_iso_of_eq w₂ = kernel_iso_of_eq (w₁.trans w₂) :=
by { unfreezingI { induction w₁, induction w₂, }, ext, simp [kernel_iso_of_eq], }

variables {f}

lemma kernel_not_epi_of_nonzero (w : f ≠ 0) : ¬epi (kernel.ι f) :=
λ I, by exactI w (eq_zero_of_epi_kernel f)

lemma kernel_not_iso_of_nonzero (w : f ≠ 0) : (is_iso (kernel.ι f)) → false :=
λ I, kernel_not_epi_of_nonzero w $ by { resetI, apply_instance }

-- TODO the remainder of this section has obvious generalizations to `has_equalizer f g`.

instance has_kernel_comp_mono {X Y Z : C} (f : X ⟶ Y) [has_kernel f] (g : Y ⟶ Z) [mono g] :
  has_kernel (f ≫ g) :=
{ exists_limit :=
  ⟨{ cone := kernel_fork.of_ι (kernel.ι f) (by simp),
     is_limit := is_limit_aux _ (λ s, kernel.lift _ s.ι ((cancel_mono g).mp (by simp)))
      (by tidy) (by tidy) }⟩ }

/--
When `g` is a monomorphism, the kernel of `f ≫ g` is isomorphic to the kernel of `f`.
-/
@[simps]
def kernel_comp_mono {X Y Z : C} (f : X ⟶ Y) (g : Y ⟶ Z) [has_kernel f] [mono g] :
  kernel (f ≫ g) ≅ kernel f :=
{ hom := kernel.lift _ (kernel.ι _) (by { rw [←cancel_mono g], simp, }),
  inv := kernel.lift _ (kernel.ι _) (by simp), }

instance has_kernel_iso_comp {X Y Z : C} (f : X ⟶ Y) (g : Y ⟶ Z) [is_iso f] [has_kernel g] :
  has_kernel (f ≫ g) :=
{ exists_limit :=
  ⟨{ cone := kernel_fork.of_ι (kernel.ι g ≫ inv f) (by simp),
     is_limit := is_limit_aux _ (λ s, kernel.lift _ (s.ι ≫ f) (by tidy)) (by tidy)
       (λ s m w, by { simp_rw [←w], ext, simp, }), }⟩ }

/--
When `f` is an isomorphism, the kernel of `f ≫ g` is isomorphic to the kernel of `g`.
-/
@[simps]
def kernel_is_iso_comp {X Y Z : C} (f : X ⟶ Y) (g : Y ⟶ Z) [is_iso f] [has_kernel g] :
  kernel (f ≫ g) ≅ kernel g :=
{ hom := kernel.lift _ (kernel.ι _ ≫ f) (by simp),
  inv := kernel.lift _ (kernel.ι _ ≫ inv f) (by simp), }

end

section has_zero_object
variables [has_zero_object C]

local attribute [instance] has_zero_object.has_zero

/-- The morphism from the zero object determines a cone on a kernel diagram -/
def kernel.zero_cone : cone (parallel_pair f 0) :=
{ X := 0,
  π := { app := λ j, 0 }}

/-- The map from the zero object is a kernel of a monomorphism -/
def kernel.is_limit_cone_zero_cone [mono f] : is_limit (kernel.zero_cone f) :=
fork.is_limit.mk _ (λ s, 0)
  (λ s, by { erw zero_comp,
    convert (zero_of_comp_mono f _).symm,
    exact kernel_fork.condition _ })
  (λ _ _ _, zero_of_to_zero _)

/-- The kernel of a monomorphism is isomorphic to the zero object -/
def kernel.of_mono [has_kernel f] [mono f] : kernel f ≅ 0 :=
functor.map_iso (cones.forget _) $ is_limit.unique_up_to_iso
  (limit.is_limit (parallel_pair f 0)) (kernel.is_limit_cone_zero_cone f)

/-- The kernel morphism of a monomorphism is a zero morphism -/
lemma kernel.ι_of_mono [has_kernel f] [mono f] : kernel.ι f = 0 :=
zero_of_source_iso_zero _ (kernel.of_mono f)

end has_zero_object

section transport

/-- If `i` is an isomorphism such that `l ≫ i.hom = f`, then any kernel of `f` is a kernel of `l`.-/
def is_kernel.of_comp_iso {Z : C} (l : X ⟶ Z) (i : Z ≅ Y) (h : l ≫ i.hom = f)
  {s : kernel_fork f} (hs : is_limit s) : is_limit (kernel_fork.of_ι (fork.ι s) $
    show fork.ι s ≫ l = 0, by simp [←i.comp_inv_eq.2 h.symm]) :=
fork.is_limit.mk _
  (λ s, hs.lift $ kernel_fork.of_ι (fork.ι s) $ by simp [←h])
  (λ s, by simp)
  (λ s m h, by { apply fork.is_limit.hom_ext hs, simpa using h walking_parallel_pair.zero })

/-- If `i` is an isomorphism such that `l ≫ i.hom = f`, then the kernel of `f` is a kernel of `l`.-/
def kernel.of_comp_iso [has_kernel f]
  {Z : C} (l : X ⟶ Z) (i : Z ≅ Y) (h : l ≫ i.hom = f) :
  is_limit (kernel_fork.of_ι (kernel.ι f) $
    show kernel.ι f ≫ l = 0, by simp [←i.comp_inv_eq.2 h.symm]) :=
is_kernel.of_comp_iso f l i h $ limit.is_limit _

/-- If `s` is any limit kernel cone over `f` and if  `i` is an isomorphism such that
    `i.hom ≫ s.ι  = l`, then `l` is a kernel of `f`. -/
def is_kernel.iso_kernel {Z : C} (l : Z ⟶ X) {s : kernel_fork f} (hs : is_limit s)
  (i : Z ≅ s.X) (h : i.hom ≫ fork.ι s = l) : is_limit (kernel_fork.of_ι l $
    show l ≫ f = 0, by simp [←h]) :=
is_limit.of_iso_limit hs $ cones.ext i.symm $ λ j,
  by { cases j, { exact (iso.eq_inv_comp i).2 h }, { simp } }

/-- If `i` is an isomorphism such that `i.hom ≫ kernel.ι f = l`, then `l` is a kernel of `f`. -/
def kernel.iso_kernel [has_kernel f]
  {Z : C} (l : Z ⟶ X) (i : Z ≅ kernel f) (h : i.hom ≫ kernel.ι f = l) :
  is_limit (kernel_fork.of_ι l $ by simp [←h]) :=
is_kernel.iso_kernel f l (limit.is_limit _) i h

end transport

section
variables (X Y)

/-- The kernel morphism of a zero morphism is an isomorphism -/
lemma kernel.ι_of_zero : is_iso (kernel.ι (0 : X ⟶ Y)) :=
equalizer.ι_of_self _

end

section

/-- A cokernel cofork is just a cofork where the second morphism is a zero morphism. -/
abbreviation cokernel_cofork := cofork f 0

variables {f}

@[simp, reassoc] lemma cokernel_cofork.condition (s : cokernel_cofork f) : f ≫ cofork.π s = 0 :=
by rw [cofork.condition, zero_comp]

@[simp] lemma cokernel_cofork.app_zero (s : cokernel_cofork f) : s.ι.app zero = 0 :=
by rw [←cofork.left_app_one, cokernel_cofork.condition]

/-- A morphism `π` satisfying `f ≫ π = 0` determines a cokernel cofork on `f`. -/
abbreviation cokernel_cofork.of_π {Z : C} (π : Y ⟶ Z) (w : f ≫ π = 0) : cokernel_cofork f :=
cofork.of_π π $ by rw [w, zero_comp]

@[simp] lemma cokernel_cofork.π_of_π {X Y P : C} (f : X ⟶ Y) (π : Y ⟶ P) (w : f ≫ π = 0) :
  cofork.π (cokernel_cofork.of_π π w) = π := rfl

/-- Every cokernel cofork `s` is isomorphic (actually, equal) to `cofork.of_π (cofork.π s) _`. -/
def iso_of_π (s : cofork f 0) : s ≅ cofork.of_π (cofork.π s) (cofork.condition s) :=
cocones.ext (iso.refl _) $ λ j, by cases j; tidy

/-- If `π = π'`, then `cokernel_cofork.of_π π _` and `cokernel_cofork.of_π π' _` are isomorphic. -/
def of_π_congr {P : C} {π π' : Y ⟶ P} {w : f ≫ π = 0} (h : π = π') :
  cokernel_cofork.of_π π w ≅ cokernel_cofork.of_π π' (by rw [←h, w]) :=
cocones.ext (iso.refl _) $ λ j, by cases j; tidy

/-- If `s` is a colimit cokernel cofork, then every `k : Y ⟶ W` satisfying `f ≫ k = 0` induces
    `l : s.X ⟶ W` such that `cofork.π s ≫ l = k`. -/
def cokernel_cofork.is_colimit.desc' {s : cokernel_cofork f} (hs : is_colimit s) {W : C} (k : Y ⟶ W)
  (h : f ≫ k = 0) : {l : s.X ⟶ W // cofork.π s ≫ l = k} :=
⟨hs.desc $ cokernel_cofork.of_π _ h, hs.fac _ _⟩

/--
This is a slightly more convenient method to verify that a cokernel cofork is a colimit cocone.
It only asks for a proof of facts that carry any mathematical content -/
def is_colimit_aux (t : cokernel_cofork f)
  (desc : Π (s : cokernel_cofork f), t.X ⟶ s.X)
  (fac : ∀ (s : cokernel_cofork f), t.π ≫ desc s = s.π)
  (uniq : ∀ (s : cokernel_cofork f) (m : t.X ⟶ s.X) (w : t.π ≫ m = s.π), m = desc s) :
  is_colimit t :=
{ desc := desc,
  fac' := λ s j, by { cases j, { simp, }, { exact fac s, }, },
  uniq' := λ s m w, uniq s m (w limits.walking_parallel_pair.one), }

/--
This is a more convenient formulation to show that a `cokernel_cofork` constructed using
`cokernel_cofork.of_π` is a limit cone.
-/
def is_colimit.of_π {Z : C} (g : Y ⟶ Z) (eq : f ≫ g = 0)
  (desc : Π {Z' : C} (g' : Y ⟶ Z') (eq' : f ≫ g' = 0), Z ⟶ Z')
  (fac : ∀ {Z' : C} (g' : Y ⟶ Z') (eq' : f ≫ g' = 0), g ≫ desc g' eq' = g')
  (uniq :
    ∀ {Z' : C} (g' : Y ⟶ Z') (eq' : f ≫ g' = 0) (m : Z ⟶ Z') (w : g ≫ m = g'), m = desc g' eq') :
  is_colimit (cokernel_cofork.of_π g eq) :=
is_colimit_aux _ (λ s, desc s.π s.condition) (λ s, fac s.π s.condition) (λ s, uniq s.π s.condition)

end

section
variables [has_cokernel f]

/-- The cokernel of a morphism, expressed as the coequalizer with the 0 morphism. -/
abbreviation cokernel : C := coequalizer f 0

/-- The map from the target of `f` to `cokernel f`. -/
abbreviation cokernel.π : Y ⟶ cokernel f := coequalizer.π f 0

@[simp] lemma coequalizer_as_cokernel : coequalizer.π f 0 = cokernel.π f := rfl

@[simp, reassoc] lemma cokernel.condition : f ≫ cokernel.π f = 0 :=
cokernel_cofork.condition _

/-- Given any morphism `k : Y ⟶ W` such that `f ≫ k = 0`, `k` factors through `cokernel.π f`
    via `cokernel.desc : cokernel f ⟶ W`. -/
abbreviation cokernel.desc {W : C} (k : Y ⟶ W) (h : f ≫ k = 0) : cokernel f ⟶ W :=
colimit.desc (parallel_pair f 0) (cokernel_cofork.of_π k h)

@[simp, reassoc]
lemma cokernel.π_desc {W : C} (k : Y ⟶ W) (h : f ≫ k = 0) :
  cokernel.π f ≫ cokernel.desc f k h = k :=
colimit.ι_desc _ _

@[simp]
lemma cokernel.desc_zero {W : C} {h} : cokernel.desc f (0 : Y ⟶ W) h = 0 :=
by { ext, simp, }

instance cokernel.desc_epi
  {W : C} (k : Y ⟶ W) (h : f ≫ k = 0) [epi k] : epi (cokernel.desc f k h) :=
⟨λ Z g g' w,
begin
  replace w := cokernel.π f ≫= w,
  simp only [cokernel.π_desc_assoc] at w,
  exact (cancel_epi k).1 w,
end⟩

/-- Any morphism `k : Y ⟶ W` satisfying `f ≫ k = 0` induces `l : cokernel f ⟶ W` such that
    `cokernel.π f ≫ l = k`. -/
def cokernel.desc' {W : C} (k : Y ⟶ W) (h : f ≫ k = 0) :
  {l : cokernel f ⟶ W // cokernel.π f ≫ l = k} :=
⟨cokernel.desc f k h, cokernel.π_desc _ _ _⟩

/-- The cokernel of the zero morphism is an isomorphism -/
instance cokernel.π_zero_is_iso :
  is_iso (cokernel.π (0 : X ⟶ Y)) :=
coequalizer.π_of_self _

lemma eq_zero_of_mono_cokernel [mono (cokernel.π f)] : f = 0 :=
(cancel_mono (cokernel.π f)).1 (by simp)

/-- The cokernel of a zero morphism is isomorphic to the target. -/
def cokernel_zero_iso_target : cokernel (0 : X ⟶ Y) ≅ Y :=
coequalizer.iso_target_of_self 0

@[simp] lemma cokernel_zero_iso_target_hom :
  cokernel_zero_iso_target.hom = cokernel.desc (0 : X ⟶ Y) (𝟙 Y) (by simp) :=
by { ext, simp [cokernel_zero_iso_target], }

@[simp] lemma cokernel_zero_iso_target_inv :
  cokernel_zero_iso_target.inv = cokernel.π (0 : X ⟶ Y) := rfl

/-- If two morphisms are known to be equal, then their cokernels are isomorphic. -/
def cokernel_iso_of_eq {f g : X ⟶ Y} [has_cokernel f] [has_cokernel g] (h : f = g) :
  cokernel f ≅ cokernel g :=
has_colimit.iso_of_nat_iso (by simp[h])

@[simp]
lemma cokernel_iso_of_eq_refl {h : f = f} : cokernel_iso_of_eq h = iso.refl (cokernel f) :=
by { ext, simp [cokernel_iso_of_eq], }

@[simp]
lemma cokernel_iso_of_eq_trans {f g h : X ⟶ Y} [has_cokernel f] [has_cokernel g] [has_cokernel h]
  (w₁ : f = g) (w₂ : g = h) :
  cokernel_iso_of_eq w₁ ≪≫ cokernel_iso_of_eq w₂ = cokernel_iso_of_eq (w₁.trans w₂) :=
by { unfreezingI { induction w₁, induction w₂, }, ext, simp [cokernel_iso_of_eq], }

variables {f}

lemma cokernel_not_mono_of_nonzero (w : f ≠ 0) : ¬mono (cokernel.π f) :=
λ I, by exactI w (eq_zero_of_mono_cokernel f)

lemma cokernel_not_iso_of_nonzero (w : f ≠ 0) : (is_iso (cokernel.π f)) → false :=
λ I, cokernel_not_mono_of_nonzero w $ by { resetI, apply_instance }

-- TODO the remainder of this section has obvious generalizations to `has_coequalizer f g`.

instance has_cokernel_comp_iso {X Y Z : C} (f : X ⟶ Y) (g : Y ⟶ Z) [has_cokernel f] [is_iso g] :
  has_cokernel (f ≫ g) :=
{ exists_colimit :=
  ⟨{ cocone := cokernel_cofork.of_π (inv g ≫ cokernel.π f) (by simp),
     is_colimit := is_colimit_aux _ (λ s, cokernel.desc _ (g ≫ s.π)
       (by { rw [←category.assoc, cokernel_cofork.condition], }))
       (by tidy)
       (λ s m w, by { simp_rw [←w], ext, simp, }), }⟩ }

/--
When `g` is an isomorphism, the cokernel of `f ≫ g` is isomorphic to the cokernel of `f`.
-/
@[simps]
def cokernel_comp_is_iso {X Y Z : C} (f : X ⟶ Y) (g : Y ⟶ Z) [has_cokernel f] [is_iso g] :
  cokernel (f ≫ g) ≅ cokernel f :=
{ hom := cokernel.desc _ (inv g ≫ cokernel.π f) (by simp),
  inv := cokernel.desc _ (g ≫ cokernel.π (f ≫ g)) (by rw [←category.assoc, cokernel.condition]), }

instance has_cokernel_epi_comp {X Y Z : C} (f : X ⟶ Y) [epi f] (g : Y ⟶ Z) [has_cokernel g] :
  has_cokernel (f ≫ g) :=
{ exists_colimit :=
  ⟨{ cocone := cokernel_cofork.of_π (cokernel.π g) (by simp),
     is_colimit := is_colimit_aux _
      (λ s, cokernel.desc _ s.π ((cancel_epi f).mp (by { rw ← category.assoc, simp })))
      (by tidy) (by tidy) }⟩ }

/--
When `f` is an epimorphism, the cokernel of `f ≫ g` is isomorphic to the cokernel of `g`.
-/
@[simps]
def cokernel_epi_comp {X Y Z : C} (f : X ⟶ Y) (g : Y ⟶ Z)
  [epi f] [has_cokernel g] :
  cokernel (f ≫ g) ≅ cokernel g :=
{ hom := cokernel.desc _ (cokernel.π g) (by simp),
  inv := cokernel.desc _ (cokernel.π (f ≫ g)) (by { rw [←cancel_epi f, ←category.assoc], simp, }), }

end

section has_zero_object
variables [has_zero_object C]

local attribute [instance] has_zero_object.has_zero

/-- The morphism to the zero object determines a cocone on a cokernel diagram -/
def cokernel.zero_cocone : cocone (parallel_pair f 0) :=
{ X := 0,
  ι := { app := λ j, 0 } }

/-- The morphism to the zero object is a cokernel of an epimorphism -/
def cokernel.is_colimit_cocone_zero_cocone [epi f] : is_colimit (cokernel.zero_cocone f) :=
cofork.is_colimit.mk _ (λ s, 0)
  (λ s, by { erw zero_comp,
    convert (zero_of_epi_comp f _).symm,
    exact cokernel_cofork.condition _ })
  (λ _ _ _, zero_of_from_zero _)

/-- The cokernel of an epimorphism is isomorphic to the zero object -/
def cokernel.of_epi [has_cokernel f] [epi f] : cokernel f ≅ 0 :=
functor.map_iso (cocones.forget _) $ is_colimit.unique_up_to_iso
  (colimit.is_colimit (parallel_pair f 0)) (cokernel.is_colimit_cocone_zero_cocone f)

/-- The cokernel morphism of an epimorphism is a zero morphism -/
lemma cokernel.π_of_epi [has_cokernel f] [epi f] : cokernel.π f = 0 :=
zero_of_target_iso_zero _ (cokernel.of_epi f)

end has_zero_object

section has_image

/--
The cokernel of the image inclusion of a morphism `f` is isomorphic to the cokernel of `f`.

(This result requires that the factorisation through the image is an epimorphism.
This holds in any category with equalizers.)
-/
@[simps]
def cokernel_image_ι {X Y : C} (f : X ⟶ Y)
  [has_image f] [has_cokernel (image.ι f)] [has_cokernel f] [epi (factor_thru_image f)] :
  cokernel (image.ι f) ≅ cokernel f :=
{ hom := cokernel.desc _ (cokernel.π f)
  begin
    have w := cokernel.condition f,
    conv at w { to_lhs, congr, rw ←image.fac f, },
    rw [←has_zero_morphisms.comp_zero (limits.factor_thru_image f), category.assoc, cancel_epi]
      at w,
    exact w,
  end,
  inv := cokernel.desc _ (cokernel.π _)
  begin
    conv { to_lhs, congr, rw ←image.fac f, },
    rw [category.assoc, cokernel.condition, has_zero_morphisms.comp_zero],
  end, }

end has_image

section
variables (X Y)

/-- The cokernel of a zero morphism is an isomorphism -/
lemma cokernel.π_of_zero :
  is_iso (cokernel.π (0 : X ⟶ Y)) :=
coequalizer.π_of_self _

end

section has_zero_object
variables [has_zero_object C]

local attribute [instance] has_zero_object.has_zero

/-- The kernel of the cokernel of an epimorphism is an isomorphism -/
instance kernel.of_cokernel_of_epi [has_cokernel f]
  [has_kernel (cokernel.π f)] [epi f] : is_iso (kernel.ι (cokernel.π f)) :=
equalizer.ι_of_eq $ cokernel.π_of_epi f

/-- The cokernel of the kernel of a monomorphism is an isomorphism -/
instance cokernel.of_kernel_of_mono [has_kernel f]
  [has_cokernel (kernel.ι f)] [mono f] : is_iso (cokernel.π (kernel.ι f)) :=
coequalizer.π_of_eq $ kernel.ι_of_mono f

end has_zero_object

section transport

/-- If `i` is an isomorphism such that `i.hom ≫ l = f`, then any cokernel of `f` is a cokernel of
    `l`. -/
def is_cokernel.of_iso_comp {Z : C} (l : Z ⟶ Y) (i : X ≅ Z) (h : i.hom ≫ l = f)
  {s : cokernel_cofork f} (hs : is_colimit s) : is_colimit (cokernel_cofork.of_π (cofork.π s) $
    show l ≫ cofork.π s = 0, by simp [i.eq_inv_comp.2 h]) :=
cofork.is_colimit.mk _
  (λ s, hs.desc $ cokernel_cofork.of_π (cofork.π s) $ by simp [←h])
  (λ s, by simp)
  (λ s m h, by { apply cofork.is_colimit.hom_ext hs, simpa using h walking_parallel_pair.one })

/-- If `i` is an isomorphism such that `i.hom ≫ l = f`, then the cokernel of `f` is a cokernel of
    `l`. -/
def cokernel.of_iso_comp [has_cokernel f]
  {Z : C} (l : Z ⟶ Y) (i : X ≅ Z) (h : i.hom ≫ l = f) :
  is_colimit (cokernel_cofork.of_π (cokernel.π f) $
    show l ≫ cokernel.π f = 0, by simp [i.eq_inv_comp.2 h]) :=
is_cokernel.of_iso_comp f l i h $ colimit.is_colimit _

/-- If `s` is any colimit cokernel cocone over `f` and `i` is an isomorphism such that
    `s.π ≫ i.hom = l`, then `l` is a cokernel of `f`. -/
def is_cokernel.cokernel_iso {Z : C} (l : Y ⟶ Z) {s : cokernel_cofork f} (hs : is_colimit s)
  (i : s.X ≅ Z) (h : cofork.π s ≫ i.hom = l) : is_colimit (cokernel_cofork.of_π l $
    show f ≫ l = 0, by simp [←h]) :=
is_colimit.of_iso_colimit hs $ cocones.ext i $ λ j, by { cases j, { simp }, { exact h } }

/-- If `i` is an isomorphism such that `cokernel.π f ≫ i.hom = l`, then `l` is a cokernel of `f`. -/
def cokernel.cokernel_iso [has_cokernel f]
  {Z : C} (l : Y ⟶ Z) (i : cokernel f ≅ Z) (h : cokernel.π f ≫ i.hom = l) :
  is_colimit (cokernel_cofork.of_π l $ by simp [←h]) :=
is_cokernel.cokernel_iso f l (colimit.is_colimit _) i h

end transport

end category_theory.limits

namespace category_theory.limits
variables (C : Type u) [category.{v} C]

variables [has_zero_morphisms C]

/-- `has_kernels` represents the existence of kernels for every morphism. -/
class has_kernels : Prop :=
(has_limit : Π {X Y : C} (f : X ⟶ Y), has_kernel f . tactic.apply_instance)

/-- `has_cokernels` represents the existence of cokernels for every morphism. -/
class has_cokernels : Prop :=
(has_colimit : Π {X Y : C} (f : X ⟶ Y), has_cokernel f . tactic.apply_instance)

attribute [instance, priority 100] has_kernels.has_limit has_cokernels.has_colimit

@[priority 100]
instance has_kernels_of_has_equalizers [has_equalizers C] : has_kernels C :=
{}

@[priority 100]
instance has_cokernels_of_has_coequalizers [has_coequalizers C] : has_cokernels C :=
{}

end category_theory.limits


/-
Copyright (c) 2020 Eric Wieser. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Eric Wieser
-/
import logic.basic

/-!
# Extra facts about `pprod`
-/

open function
variables {α β γ δ : Sort*}

namespace pprod

@[simp] lemma mk.eta {p : pprod α β} : pprod.mk p.1 p.2 = p :=
pprod.cases_on p (λ a b, rfl)

@[simp] theorem «forall» {p : pprod α β → Prop} : (∀ x, p x) ↔ (∀ a b, p ⟨a, b⟩) :=
⟨assume h a b, h ⟨a, b⟩, assume h ⟨a, b⟩, h a b⟩

@[simp] theorem «exists» {p : pprod α β → Prop} : (∃ x, p x) ↔ (∃ a b, p ⟨a, b⟩) :=
⟨assume ⟨⟨a, b⟩, h⟩, ⟨a, b, h⟩, assume ⟨a, b, h⟩, ⟨⟨a, b⟩, h⟩⟩

theorem forall' {p : α → β → Prop} : (∀ x : pprod α β, p x.1 x.2) ↔ ∀ a b, p a b :=
pprod.forall

theorem exists' {p : α → β → Prop} : (∃ x : pprod α β, p x.1 x.2) ↔ ∃ a b, p a b :=
pprod.exists

end pprod

lemma function.injective.pprod_map {f : α → β} {g : γ → δ} (hf : injective f) (hg : injective g) :
  injective (λ x, ⟨f x.1, g x.2⟩ : pprod α γ → pprod β δ) :=
λ ⟨x₁, x₂⟩ ⟨y₁, y₂⟩ h,
have A : _ := congr_arg pprod.fst h,
have B : _ := congr_arg pprod.snd h,
congr_arg2 pprod.mk (hf A) (hg B)


/-
Copyright (c) 2022 Anatole Dedecker. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Anatole Dedecker
-/
import analysis.convex.topology
/-!
# Locally convex topological modules

A `locally_convex_space` is a topological semimodule over an ordered semiring in which any point
admits a neighborhood basis made of convex sets, or equivalently, in which convex neighborhoods of
a point form a neighborhood basis at that point.

In a module, this is equivalent to `0` satisfying such properties.

## Main results

- `locally_convex_space_iff_zero` : in a module, local convexity at zero gives
  local convexity everywhere
- `seminorm.locally_convex_space` : a topology generated by a family of seminorms is locally convex
- `normed_space.locally_convex_space` : a normed space is locally convex

## TODO

- define a structure `locally_convex_filter_basis`, extending `module_filter_basis`, for filter
  bases generating a locally convex topology

-/

open topological_space filter set

open_locale topology pointwise

section semimodule

/-- A `locally_convex_space` is a topological semimodule over an ordered semiring in which convex
neighborhoods of a point form a neighborhood basis at that point. -/
class locally_convex_space (𝕜 E : Type*) [ordered_semiring 𝕜] [add_comm_monoid E] [module 𝕜 E]
  [topological_space E] : Prop :=
(convex_basis : ∀ x : E, (𝓝 x).has_basis (λ (s : set E), s ∈ 𝓝 x ∧ convex 𝕜 s) id)

variables (𝕜 E : Type*) [ordered_semiring 𝕜] [add_comm_monoid E] [module 𝕜 E] [topological_space E]

lemma locally_convex_space_iff :
  locally_convex_space 𝕜 E ↔
  ∀ x : E, (𝓝 x).has_basis (λ (s : set E), s ∈ 𝓝 x ∧ convex 𝕜 s) id :=
⟨@locally_convex_space.convex_basis _ _ _ _ _ _, locally_convex_space.mk⟩

lemma locally_convex_space.of_bases {ι : Type*} (b : E → ι → set E) (p : E → ι → Prop)
  (hbasis : ∀ x : E, (𝓝 x).has_basis (p x) (b x)) (hconvex : ∀ x i, p x i → convex 𝕜 (b x i)) :
  locally_convex_space 𝕜 E :=
⟨λ x, (hbasis x).to_has_basis
  (λ i hi, ⟨b x i, ⟨⟨(hbasis x).mem_of_mem hi, hconvex x i hi⟩, le_refl (b x i)⟩⟩)
  (λ s hs, ⟨(hbasis x).index s hs.1,
    ⟨(hbasis x).property_index hs.1, (hbasis x).set_index_subset hs.1⟩⟩)⟩

lemma locally_convex_space.convex_basis_zero [locally_convex_space 𝕜 E] :
  (𝓝 0 : filter E).has_basis (λ s, s ∈ (𝓝 0 : filter E) ∧ convex 𝕜 s) id :=
locally_convex_space.convex_basis 0

lemma locally_convex_space_iff_exists_convex_subset :
  locally_convex_space 𝕜 E ↔ ∀ x : E, ∀ U ∈ 𝓝 x, ∃ S ∈ 𝓝 x, convex 𝕜 S ∧ S ⊆ U :=
(locally_convex_space_iff 𝕜 E).trans (forall_congr $ λ x, has_basis_self)

end semimodule

section module

variables (𝕜 E : Type*) [ordered_semiring 𝕜] [add_comm_group E] [module 𝕜 E] [topological_space E]
  [topological_add_group E]

lemma locally_convex_space.of_basis_zero {ι : Type*} (b : ι → set E) (p : ι → Prop)
  (hbasis : (𝓝 0).has_basis p b) (hconvex : ∀ i, p i → convex 𝕜 (b i)) :
  locally_convex_space 𝕜 E :=
begin
  refine locally_convex_space.of_bases 𝕜 E (λ (x : E) (i : ι), ((+) x) '' b i) (λ _, p) (λ x, _)
    (λ x i hi, (hconvex i hi).translate x),
  rw ← map_add_left_nhds_zero,
  exact hbasis.map _
end

lemma locally_convex_space_iff_zero :
  locally_convex_space 𝕜 E ↔
  (𝓝 0 : filter E).has_basis (λ (s : set E), s ∈ (𝓝 0 : filter E) ∧ convex 𝕜 s) id :=
⟨λ h, @locally_convex_space.convex_basis _ _ _ _ _ _ h 0,
 λ h, locally_convex_space.of_basis_zero 𝕜 E _ _ h (λ s, and.right)⟩

lemma locally_convex_space_iff_exists_convex_subset_zero :
  locally_convex_space 𝕜 E ↔
  ∀ U ∈ (𝓝 0 : filter E), ∃ S ∈ (𝓝 0 : filter E), convex 𝕜 S ∧ S ⊆ U :=
(locally_convex_space_iff_zero 𝕜 E).trans has_basis_self

-- see Note [lower instance priority]
@[priority 100] instance locally_convex_space.to_locally_connected_space [module ℝ E]
  [has_continuous_smul ℝ E] [locally_convex_space ℝ E] :
  locally_connected_space E :=
locally_connected_space_of_connected_bases _ _
  (λ x, @locally_convex_space.convex_basis ℝ _ _ _ _ _ _ x)
  (λ x s hs, hs.2.is_preconnected)

end module

section linear_ordered_field

variables (𝕜 E : Type*) [linear_ordered_field 𝕜] [add_comm_group E] [module 𝕜 E]
  [topological_space E] [topological_add_group E] [has_continuous_const_smul 𝕜 E]

lemma locally_convex_space.convex_open_basis_zero [locally_convex_space 𝕜 E] :
  (𝓝 0 : filter E).has_basis (λ s, (0 : E) ∈ s ∧ is_open s ∧ convex 𝕜 s) id :=
(locally_convex_space.convex_basis_zero 𝕜 E).to_has_basis
  (λ s hs, ⟨interior s, ⟨mem_interior_iff_mem_nhds.mpr hs.1, is_open_interior,
    hs.2.interior⟩, interior_subset⟩)
  (λ s hs, ⟨s, ⟨hs.2.1.mem_nhds hs.1, hs.2.2⟩, subset_rfl⟩)

variables {𝕜 E}

/-- In a locally convex space, if `s`, `t` are disjoint convex sets, `s` is compact and `t` is
closed, then we can find open disjoint convex sets containing them. -/
lemma disjoint.exists_open_convexes [locally_convex_space 𝕜 E] {s t : set E} (disj : disjoint s t)
  (hs₁ : convex 𝕜 s) (hs₂ : is_compact s) (ht₁ : convex 𝕜 t) (ht₂ : is_closed t) :
  ∃ u v, is_open u ∧ is_open v ∧ convex 𝕜 u ∧ convex 𝕜 v ∧ s ⊆ u ∧ t ⊆ v ∧ disjoint u v :=
begin
  letI : uniform_space E := topological_add_group.to_uniform_space E,
  haveI : uniform_add_group E := topological_add_comm_group_is_uniform,
  have := (locally_convex_space.convex_open_basis_zero 𝕜 E).comap (λ x : E × E, x.2 - x.1),
  rw ← uniformity_eq_comap_nhds_zero at this,
  rcases disj.exists_uniform_thickening_of_basis this hs₂ ht₂
    with ⟨V, ⟨hV0, hVopen, hVconvex⟩, hV⟩,
  refine ⟨s + V, t + V, hVopen.add_left, hVopen.add_left, hs₁.add hVconvex, ht₁.add hVconvex,
    subset_add_left _ hV0, subset_add_left _ hV0, _⟩,
  simp_rw [←Union_add_left_image, image_add_left],
  simp_rw [uniform_space.ball, ←preimage_comp, sub_eq_neg_add] at hV,
  exact hV
end

end linear_ordered_field

section lattice_ops

variables {ι : Sort*} {𝕜 E F : Type*} [ordered_semiring 𝕜] [add_comm_monoid E]
  [module 𝕜 E] [add_comm_monoid F] [module 𝕜 F]

lemma locally_convex_space_Inf {ts : set (topological_space E)}
  (h : ∀ t ∈ ts, @locally_convex_space 𝕜 E  _ _ _ t) :
  @locally_convex_space 𝕜 E _ _ _ (Inf ts) :=
begin
  letI : topological_space E := Inf ts,
  refine locally_convex_space.of_bases 𝕜 E
    (λ x, λ If : set ts × (ts → set E), ⋂ i ∈ If.1, If.2 i)
    (λ x, λ If : set ts × (ts → set E), If.1.finite ∧ ∀ i ∈ If.1,
      ((If.2 i) ∈ @nhds _ ↑i x ∧ convex 𝕜 (If.2 i)))
    (λ x, _) (λ x If hif, convex_Inter $ λ i, convex_Inter $ λ hi, (hif.2 i hi).2),
  rw [nhds_Inf, ← infi_subtype''],
  exact has_basis_infi' (λ i : ts, (@locally_convex_space_iff 𝕜 E _ _ _ ↑i).mp (h ↑i i.2) x),
end

lemma locally_convex_space_infi {ts' : ι → topological_space E}
  (h' : ∀ i, @locally_convex_space 𝕜 E  _ _ _ (ts' i)) :
  @locally_convex_space 𝕜 E _ _ _ (⨅ i, ts' i) :=
begin
  refine locally_convex_space_Inf _,
  rwa forall_range_iff
end

lemma locally_convex_space_inf {t₁ t₂ : topological_space E}
  (h₁ : @locally_convex_space 𝕜 E _ _ _ t₁) (h₂ : @locally_convex_space 𝕜 E _ _ _ t₂) :
  @locally_convex_space 𝕜 E _ _ _ (t₁ ⊓ t₂) :=
by {rw inf_eq_infi, refine locally_convex_space_infi (λ b, _), cases b; assumption}

lemma locally_convex_space_induced {t : topological_space F} [locally_convex_space 𝕜 F]
  (f : E →ₗ[𝕜] F) :
  @locally_convex_space 𝕜 E _ _ _ (t.induced f) :=
begin
  letI : topological_space E := t.induced f,
  refine locally_convex_space.of_bases 𝕜 E (λ x, preimage f)
    (λ x, λ (s : set F), s ∈ 𝓝 (f x) ∧ convex 𝕜 s) (λ x, _)
    (λ x s ⟨_, hs⟩, hs.linear_preimage f),
  rw nhds_induced,
  exact (locally_convex_space.convex_basis $ f x).comap f
end

instance {ι : Type*} {X : ι → Type*} [Π i, add_comm_monoid (X i)] [Π i, topological_space (X i)]
  [Π i, module 𝕜 (X i)] [Π i, locally_convex_space 𝕜 (X i)] :
  locally_convex_space 𝕜 (Π i, X i) :=
locally_convex_space_infi (λ i, locally_convex_space_induced (linear_map.proj i))

instance [topological_space E] [topological_space F] [locally_convex_space 𝕜 E]
  [locally_convex_space 𝕜 F] :
  locally_convex_space 𝕜 (E × F) :=
locally_convex_space_inf
  (locally_convex_space_induced (linear_map.fst _ _ _))
  (locally_convex_space_induced (linear_map.snd _ _ _))

end lattice_ops


/-
Copyright (c) 2018 Reid Barton. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Reid Barton

Type of continuous maps and the compact-open topology on them.
-/

import topology.constructions tactic.tidy

open set

universes u v w

def continuous_map (α : Type u) (β : Type v) [topological_space α] [topological_space β] :
  Type (max u v) :=
subtype (continuous : (α → β) → Prop)

local notation `C(` α `, ` β `)` := continuous_map α β

namespace continuous_map

section compact_open
variables {α : Type u} {β : Type v} {γ : Type w}
variables [topological_space α] [topological_space β] [topological_space γ]

instance : has_coe_to_fun C(α, β) :=
⟨λ_, α → β, λf, f.1⟩

def compact_open.gen (s : set α) (u : set β) : set C(α,β) := {f | f '' s ⊆ u}

-- The compact-open topology on the space of continuous maps α → β.
instance compact_open : topological_space C(α, β) :=
topological_space.generate_from
  {m | ∃ (s : set α) (hs : compact s) (u : set β) (hu : is_open u), m = compact_open.gen s u}

private lemma is_open_gen {s : set α} (hs : compact s) {u : set β} (hu : is_open u) :
  is_open (compact_open.gen s u) :=
topological_space.generate_open.basic _ (by dsimp [mem_set_of_eq]; tauto)

section functorial

variables {g : β → γ} (hg : continuous g)

def induced (f : C(α, β)) : C(α, γ) := ⟨g ∘ f, f.property.comp hg⟩

private lemma preimage_gen {s : set α} (hs : compact s) {u : set γ} (hu : is_open u) :
  continuous_map.induced hg ⁻¹' (compact_open.gen s u) = compact_open.gen s (g ⁻¹' u) :=
begin
  ext ⟨f, _⟩,
  change g ∘ f '' s ⊆ u ↔ f '' s ⊆ g ⁻¹' u,
  rw [image_comp, image_subset_iff]
end

/-- C(α, -) is a functor. -/
lemma continuous_induced : continuous (continuous_map.induced hg : C(α, β) → C(α, γ)) :=
continuous_generated_from $ assume m ⟨s, hs, u, hu, hm⟩,
  by rw [hm, preimage_gen hg hs hu]; exact is_open_gen hs (hg _ hu)

end functorial

section ev

variables (α β)
def ev (p : C(α, β) × α) : β := p.1 p.2

variables {α β}
-- The evaluation map C(α, β) × α → β is continuous if α is locally compact.
lemma continuous_ev [locally_compact_space α] : continuous (ev α β) :=
continuous_iff_continuous_at.mpr $ assume ⟨f, x⟩ n hn,
  let ⟨v, vn, vo, fxv⟩ := mem_nhds_sets_iff.mp hn in
  have v ∈ nhds (f.val x), from mem_nhds_sets vo fxv,
  let ⟨s, hs, sv, sc⟩ :=
    locally_compact_space.local_compact_nhds x (f.val ⁻¹' v)
      (f.property.tendsto x this) in
  let ⟨u, us, uo, xu⟩ := mem_nhds_sets_iff.mp hs in
  show (ev α β) ⁻¹' n ∈ nhds (f, x), from
  let w := set.prod (compact_open.gen s v) u in
  have w ⊆ ev α β ⁻¹' n, from assume ⟨f', x'⟩ ⟨hf', hx'⟩, calc
    f'.val x' ∈ f'.val '' s  : mem_image_of_mem f'.val (us hx')
    ...       ⊆ v            : hf'
    ...       ⊆ n            : vn,
  have is_open w, from is_open_prod (is_open_gen sc vo) uo,
  have (f, x) ∈ w, from ⟨image_subset_iff.mpr sv, xu⟩,
  mem_nhds_sets_iff.mpr ⟨w, by assumption, by assumption, by assumption⟩

end ev

section coev

variables (α β)
def coev (b : β) : C(α, β × α) := ⟨λ a, (b, a), continuous.prod_mk continuous_const continuous_id⟩

variables {α β}
lemma image_coev {y : β} (s : set α) : (coev α β y).val '' s = set.prod {y} s := by tidy

-- The coevaluation map β → C(α, β × α) is continuous (always).
lemma continuous_coev : continuous (coev α β) :=
continuous_generated_from $ begin
  rintros _ ⟨s, sc, u, uo, rfl⟩,
  rw is_open_iff_forall_mem_open,
  intros y hy,
  change (coev α β y).val '' s ⊆ u at hy,
  rw image_coev s at hy,
  rcases generalized_tube_lemma compact_singleton sc uo hy
    with ⟨v, w, vo, wo, yv, sw, vwu⟩,
  refine ⟨v, _, vo, singleton_subset_iff.mp yv⟩,
  intros y' hy',
  change (coev α β y').val '' s ⊆ u,
  rw image_coev s,
  exact subset.trans (prod_mono (singleton_subset_iff.mpr hy') sw) vwu
end

end coev

end compact_open

end continuous_map


import Lean4Axiomatic.Rational.Multiplication

/-! # Rational numbers: negation and subtraction -/

namespace Lean4Axiomatic.Rational

open Logic (AP)

/-! ## Axioms -/

/-- Operations pertaining to rational number negation. -/
class Negation.Ops (ℚ : Type) :=
  /-- Negation of rational numbers. -/
  neg : ℚ → ℚ

export Negation.Ops (neg)

/-- Enables the use of the `-·` operator for negation. -/
instance neg_op_inst {ℚ : Type} [Negation.Ops ℚ] : Neg ℚ := {
  neg := neg
}

/-- Properties of rational number negation. -/
class Negation.Props
    {ℕ ℤ : outParam Type} [Natural ℕ] [Integer (ℕ := ℕ) ℤ]
    (ℚ : Type) [Core (ℤ := ℤ) ℚ] [Addition ℚ] [Ops ℚ]
    :=
  /-- Negation respects equivalence over its operand. -/
  neg_subst {p₁ p₂ : ℚ} : p₁ ≃ p₂ → -p₁ ≃ -p₂

  /-- Negation is consistent with its integer equivalent. -/
  neg_compat_from_integer {a : ℤ} : ((-a : ℤ) : ℚ) ≃ -(a : ℚ)

  /-- The negation of a value is its left additive inverse. -/
  add_inverseL {p : ℚ} : -p + p ≃ 0

  /-- The negation of a value is its right additive inverse. -/
  add_inverseR {p : ℚ} : p + -p ≃ 0

export Negation.Props (
  add_inverseL add_inverseR neg_compat_from_integer neg_subst
)

/-- All rational number negation axioms. -/
class Negation
    {ℕ ℤ : outParam Type} [Natural ℕ] [Integer (ℕ := ℕ) ℤ]
    (ℚ : Type) [Core (ℤ := ℤ) ℚ] [Addition ℚ]
    :=
  toOps : Negation.Ops ℚ
  toProps : Negation.Props ℚ

attribute [instance] Negation.toOps
attribute [instance] Negation.toProps

/-- Operations pertaining to rational number subtraction. -/
class Subtraction.Ops (ℚ : Type) :=
  /-- Subtraction of rational numbers. -/
  sub : ℚ → ℚ → ℚ

export Subtraction.Ops (sub)

/-- Enables the use of the `· - ·` operator for subtraction. -/
instance sub_op_inst {ℚ : Type} [Subtraction.Ops ℚ] : Sub ℚ := {
  sub := sub
}

/-- Properties of rational number subtraction. -/
class Subtraction.Props
    {ℕ ℤ : outParam Type} [Natural ℕ] [Integer (ℕ := ℕ) ℤ]
    (ℚ : Type) [Core (ℤ := ℤ) ℚ] [Addition ℚ] [Negation ℚ] [Ops ℚ]
    :=
  /-- Subtraction is equivalent to addition of a negated second argument. -/
  sub_add_neg {p q : ℚ} : p - q ≃ p + (-q)

export Subtraction.Props (sub_add_neg)

/-- All rational number subtraction axioms. -/
class Subtraction
    {ℕ ℤ : outParam Type} [Natural ℕ] [Integer (ℕ := ℕ) ℤ]
    (ℚ : Type) [Core (ℤ := ℤ) ℚ] [Addition ℚ] [Negation ℚ]
    :=
  toOps : Subtraction.Ops ℚ
  toProps : Subtraction.Props ℚ

attribute [instance] Subtraction.toOps
attribute [instance] Subtraction.toProps

/-! ## Derived properties -/

variable {ℕ ℤ : Type} [Natural ℕ] [Integer (ℕ := ℕ) ℤ]
variable {ℚ : Type}
  [Core (ℤ := ℤ) ℚ] [Addition ℚ] [Multiplication ℚ]
  [Negation ℚ] [Subtraction ℚ]

/--
Zero is a left absorbing element for multiplication.

The proof is identical to `Integer.mul_absorbL`; see its comment for intuition.
-/
theorem mul_absorbL {p : ℚ} : 0 * p ≃ 0 := calc
  0 * p                      ≃ _ := eqv_symm add_identR
  0 * p + 0                  ≃ _ := add_substR (eqv_symm add_inverseR)
  0 * p + (0 * p + -(0 * p)) ≃ _ := eqv_symm add_assoc
  (0 * p + 0 * p) + -(0 * p) ≃ _ := add_substL (eqv_symm mul_distribR)
  (0 + 0) * p + -(0 * p)     ≃ _ := add_substL (mul_substL add_identL)
  0 * p + -(0 * p)           ≃ _ := add_inverseR
  0                          ≃ _ := eqv_refl

/--
Zero is a right absorbing element for multiplication.

This follows from left absorption because multiplication is commutative.
-/
theorem mul_absorbR {p : ℚ} : p * 0 ≃ 0 := calc
  p * 0 ≃ _ := mul_comm
  0 * p ≃ _ := mul_absorbL
  0     ≃ _ := eqv_refl

/--
Adding or removing a negation from zero leaves it unchanged.

**Property intuition**: Zero doesn't have a sign (alternatively, it has a sign
of zero), so it can't be negated.

**Proof intuition**: Introduce the additive inverse of the variable on the left
by adding zero and turning it into the variable from the hypothesis.
-/
theorem neg_preserves_zero {p : ℚ} : -p ≃ 0 ↔ p ≃ 0 := by
  apply Iff.intro
  case mp =>
    intro (_ : -p ≃ 0)
    show p ≃ 0
    calc
      p      ≃ _ := eqv_symm add_identR
      p + 0  ≃ _ := add_substR (eqv_symm ‹-p ≃ 0›)
      p + -p ≃ _ := add_inverseR
      0      ≃ _ := eqv_refl
  case mpr =>
    intro (_ : p ≃ 0)
    show -p ≃ 0
    calc
      -p     ≃ _ := eqv_symm add_identL
      0 + -p ≃ _ := add_substL (eqv_symm ‹p ≃ 0›)
      p + -p ≃ _ := add_inverseR
      0      ≃ _ := eqv_refl

/--
The negation of a nonzero rational is also nonzero.

**Property intuition**: Negation produces the "mirror image" of a rational
number, reflected across zero. Any nonzero number will be some finite distance
away from zero, and so will its negation.

**Proof intuition**: Show that `-p ≃ 0` implies `p ≃ 0`, and take the
contrapositive.
-/
theorem neg_preserves_nonzero {p : ℚ} : p ≄ 0 → -p ≄ 0 :=
  mt neg_preserves_zero.mp

/-- Useful for having negated expressions under the division sign. -/
instance neg_preserves_nonzero_inst {p : ℚ} [AP (p ≄ 0)] : AP (-p ≄ 0) :=
  AP.mk (neg_preserves_nonzero ‹AP (p ≄ 0)›.ev)

/--
Negation is left-semicompatible with multiplication.

The proof is identical to `Integer.neg_scompatL_mul`; see its comment for
intuition.
-/
theorem neg_scompatL_mul {p q : ℚ} : -(p * q) ≃ -p * q := by
  have : 0 ≃ -p + p := eqv_symm add_inverseL
  calc
    -(p * q)                      ≃ _ := eqv_symm add_identL
    0 + -(p * q)                  ≃ _ := add_substL (eqv_symm mul_absorbL)
    0 * q + -(p * q)              ≃ _ := add_substL (mul_substL ‹0 ≃ -p + p›)
    (-p + p) * q + -(p * q)       ≃ _ := add_substL mul_distribR
    (-p * q + p * q) + -(p * q)   ≃ _ := add_assoc
    (-p) * q + (p * q + -(p * q)) ≃ _ := add_substR add_inverseR
    (-p) * q + 0                  ≃ _ := add_identR
    (-p) * q                      ≃ _ := eqv_refl

/--
Negation is right-semicompatible with multiplication.

This follows from left-semicompatibility because multiplication is commutative.
-/
theorem neg_scompatR_mul {p q : ℚ} : -(p * q) ≃ p * -q := calc
  (-(p * q)) ≃ _ := neg_subst mul_comm
  (-(q * p)) ≃ _ := neg_scompatL_mul
  (-q) * p   ≃ _ := mul_comm
  p * -q     ≃ _ := eqv_refl

/--
Multiplication by negative one is the same as negation.

The proof is identical to `Integer.mul_neg_one`; see its comment for intuition.
-/
theorem mul_neg_one {p : ℚ} : -1 * p ≃ -p := calc
  -1 * p     ≃ _ := eqv_symm neg_scompatL_mul
  (-(1 * p)) ≃ _ := neg_subst mul_identL
  (-p)       ≃ _ := eqv_refl

/--
Negating twice is the same as not negating at all.

The proof is identical to `Integer.neg_involutive`; see its comment for
intuition.
-/
theorem neg_involutive {p : ℚ} : -(-p) ≃ p := calc
  -(-p)            ≃ _ := eqv_symm add_identL
  0 + -(-p)        ≃ _ := add_substL (eqv_symm add_inverseR)
  (p + -p) + -(-p) ≃ _ := add_assoc
  p + (-p + -(-p)) ≃ _ := add_substR add_inverseR
  p + 0            ≃ _ := add_identR
  p                ≃ _ := eqv_refl

/--
The rational number `-1` is a square root of unity.

**Property and proof intuition**: This is a (nearly) trivial corollary of the
proof that integer square roots of unity are also rational square roots of
unity. There's a single, technical, complication in that the most natural
syntax for representing `-1` as a rational number is `(-1 : ℚ)`, but this is
interpreted as `(-(1 : ℤ) : ℚ)` by Lean, instead of the more convenient
`((-1 : ℤ) : ℚ)`.
-/
instance sqrt1_neg_one : Sqrt1 (-1 : ℚ) := by
  have : Integer.Sqrt1 (-1 : ℤ) := Integer.sqrt1_neg_one
  have : Sqrt1 ((-1 : ℤ) : ℚ) := from_integer_preserves_sqrt1.mpr this
  have : Sqrt1 (-1 : ℚ) := sqrt1_subst neg_compat_from_integer this
  exact this

/--
Square roots of unity are nonzero.

**Property and proof intuition**: Trivial because `p * p ≃ 1` can only hold if
`p ≄ 0`, otherwise the absorption property of zero would make the product zero.
-/
theorem sqrt1_nonzero {p : ℚ} : Sqrt1 p → p ≄ 0 := by
  intro (_ : Sqrt1 p) (_ : p ≃ 0)
  show False
  have : (1 : ℚ) ≃ 0 := calc
    (1 : ℚ) ≃ _ := eqv_symm ‹Sqrt1 p›.elim
    p * p   ≃ _ := mul_substL ‹p ≃ 0›
    0 * p   ≃ _ := mul_absorbL
    0       ≃ _ := eqv_refl
  have : (1 : ℚ) ≄ 0 := nonzero_one
  exact absurd ‹(1 : ℚ) ≃ 0› ‹(1 : ℚ) ≄ 0›

/--
Instance version of `sqrt1_nonzero`, to enable clean syntax for square roots of
unity in contexts where they need to be nonzero, such as taking reciprocals.
-/
instance sqrt1_nonzero_inst {p : ℚ} [Sqrt1 p] : AP (p ≄ 0) :=
  AP.mk (sqrt1_nonzero ‹Sqrt1 p›)

/--
Replacing the left operand of subtraction with an equivalent value gives an
equivalent result.

**Property intuition**: This must be true for subtraction to be a function on
rational numbers.

**Proof intuition**: Expand subtraction into addition; addition is left
substitutive.
-/
theorem sub_substL {p₁ p₂ q : ℚ} : p₁ ≃ p₂ → p₁ - q ≃ p₂ - q := by
  intro (_ : p₁ ≃ p₂)
  show p₁ - q ≃ p₂ - q
  calc
    p₁ - q  ≃ _ := sub_add_neg
    p₁ + -q ≃ _ := add_substL ‹p₁ ≃ p₂›
    p₂ + -q ≃ _ := eqv_symm sub_add_neg
    p₂ - q  ≃ _ := eqv_refl

/--
Replacing the right operand of subtraction with an equivalent value gives an
equivalent result.

**Property intuition**: This must be true for subtraction to be a function on
rational numbers.

**Proof intuition**: Expand subtraction into addition of the negation; addition
and negation obey substitution.
-/
theorem sub_substR {p₁ p₂ q : ℚ} : p₁ ≃ p₂ → q - p₁ ≃ q - p₂ := by
  intro (_ : p₁ ≃ p₂)
  show q - p₁ ≃ q - p₂
  calc
    q - p₁  ≃ _ := sub_add_neg
    q + -p₁ ≃ _ := add_substR (neg_subst ‹p₁ ≃ p₂›)
    q + -p₂ ≃ _ := eqv_symm sub_add_neg
    q - p₂  ≃ _ := eqv_refl

/--
Negating a subtraction operation swaps its operands.

For intuition, see the identical proof for integers, `Integer.sub_neg_flip`.
-/
theorem neg_sub {p q : ℚ} : -(p - q) ≃ q - p := calc
  -(p - q)             ≃ _ := eqv_symm mul_neg_one
  (-1) * (p - q)       ≃ _ := mul_substR sub_add_neg
  (-1) * (p + -q)      ≃ _ := mul_distribL
  (-1) * p + (-1) * -q ≃ _ := add_substL mul_neg_one
  (-p) + (-1) * -q     ≃ _ := add_substR mul_neg_one
  (-p) + -(-q)         ≃ _ := add_substR neg_involutive
  (-p) + q             ≃ _ := add_comm
  q + -p               ≃ _ := eqv_symm sub_add_neg
  q - p                ≃ _ := eqv_refl

/--
Two rational numbers are equal if and only if their difference is zero.

See `Integer.zero_diff_iff_eqv` for intuition.
-/
theorem sub_eqv_zero_iff_eqv {p q : ℚ} : p - q ≃ 0 ↔ p ≃ q := by
  apply Iff.intro
  case mp =>
    intro (_ : p - q ≃ 0)
    show p ≃ q
    calc
      p            ≃ _ := eqv_symm add_identR
      p + 0        ≃ _ := add_substR (eqv_symm add_inverseL)
      p + (-q + q) ≃ _ := eqv_symm add_assoc
      (p + -q) + q ≃ _ := add_substL (eqv_symm sub_add_neg)
      (p - q) + q  ≃ _ := add_substL ‹p - q ≃ 0›
      0 + q        ≃ _ := add_identL
      q            ≃ _ := eqv_refl
  case mpr =>
    intro (_ : p ≃ q)
    show p - q ≃ 0
    calc
      p - q  ≃ _ := sub_add_neg
      p + -q ≃ _ := add_substL ‹p ≃ q›
      q + -q ≃ _ := add_inverseR
      0      ≃ _ := eqv_refl

/--
Subtracting zero from any rational number leaves it unchanged.

**Property and proof intuition**: It's the reverse situation of adding zero.
-/
theorem sub_zero {p : ℚ} : p - 0 ≃ p := calc
  p - 0  ≃ _ := sub_add_neg
  p + -0 ≃ _ := add_substR (neg_preserves_zero.mpr eqv_refl)
  p + 0  ≃ _ := add_identR
  p      ≃ _ := eqv_refl

/--
The simplest example of a "telescoping" sum: adding two differences with a
common middle value results in the difference of the endpoints.

**Property and proof intuition**: The middle value is positive in one of the
sum's arguments, and negative in the other. Those are additive inverses so they
sum to zero and disappear from the result.
-/
theorem add_sub_telescope {p q r : ℚ} : (p - q) + (q - r) ≃ p - r := calc
  (p - q) + (q - r)   ≃ _ := add_substL sub_add_neg
  (p + -q) + (q - r)  ≃ _ := add_substR sub_add_neg
  (p + -q) + (q + -r) ≃ _ := AA.expr_xxfxxff_lr_swap_rr
  (p + -r) + (q + -q) ≃ _ := add_substR add_inverseR
  (p + -r) + 0        ≃ _ := add_identR
  p + -r              ≃ _ := eqv_symm sub_add_neg
  p - r               ≃ _ := eqv_refl

/--
A common right operand can be removed from a subtraction of two sums.

**Property intuition**: Changing two values by the same amount doesn't change
their difference.

**Proof intuition**: Expand subtraction into addition and rearrange so that the
common term and its additive inverse add to zero.
-/
theorem sub_cancelR_add {p q r : ℚ} : (p + r) - (q + r) ≃ p - q := calc
  (p + r) - (q + r)           ≃ _ := sub_add_neg
  (p + r) + -(q + r)          ≃ _ := add_substR (eqv_symm mul_neg_one)
  (p + r) + -1 * (q + r)      ≃ _ := add_substR mul_distribL
  (p + r) + (-1 * q + -1 * r) ≃ _ := add_substR (add_substL mul_neg_one)
  (p + r) + (-q + -1 * r)     ≃ _ := add_substR (add_substR mul_neg_one)
  (p + r) + (-q + -r)         ≃ _ := AA.expr_xxfxxff_lr_swap_rl
  (p + -q) + (r + -r)         ≃ _ := add_substR add_inverseR
  (p + -q) + 0                ≃ _ := add_identR
  p + -q                      ≃ _ := eqv_symm sub_add_neg
  p - q                       ≃ _ := eqv_refl

/--
Multiplication on the left distributes over subtraction.

**Property and proof intuition**: Subtraction is just addition; multiplication
distributes over addition.
-/
theorem mul_distribL_sub {p q r : ℚ} : r * (p - q) ≃ r * p - r * q := calc
   r * (p - q)      ≃ _ := mul_substR sub_add_neg
   r * (p + -q)     ≃ _ := mul_distribL
   r * p + r * -q   ≃ _ := add_substR (eqv_symm neg_scompatR_mul)
   r * p + -(r * q) ≃ _ := eqv_symm sub_add_neg
   r * p - r * q    ≃ _ := eqv_refl

/--
Multiplication on the right distributes over subtraction.

**Property and proof intuition**: Subtraction is just addition; multiplication
distributes over addition.
-/
theorem mul_distribR_sub {p q r : ℚ} : (p - q) * r ≃ p * r - q * r := calc
   (p - q) * r   ≃ _ := mul_comm
   r * (p - q)   ≃ _ := mul_distribL_sub
   r * p - r * q ≃ _ := sub_substL mul_comm
   p * r - r * q ≃ _ := sub_substR mul_comm
   p * r - q * r ≃ _ := eqv_refl

end Lean4Axiomatic.Rational


import Lean

import Smt.Reconstruction.Certifying.Pull

namespace Smt.Reconstruction.Certifying

open Lean Elab.Tactic Meta

theorem resolution_thm : ∀ {A B C : Prop}, (A ∨ B) → (¬ A ∨ C) → B ∨ C := by
  intros A B C h₁ h₂
  cases h₁ with
  | inl ap => cases h₂ with
              | inl nap => exact (False.elim (nap ap))
              | inr cp  => exact (Or.inr cp)
  | inr bp => exact (Or.inl bp)

theorem flipped_resolution_thm : ∀ {A B C : Prop}, (¬ A ∨ B) → (A ∨ C) → B ∨ C := by
  intros A B C h₁ h₂
  cases h₁ with
  | inl nap => cases h₂ with
               | inl ap => exact False.elim (nap ap)
               | inr cp => exact (Or.inr cp)
  | inr bp => exact (Or.inl bp)

theorem resolution_thm₂ : ∀ {A C: Prop}, A → (¬ A ∨ C) → C := λ a ornac =>
  match ornac with
  | Or.inl na => False.elim (na a)
  | Or.inr c  => c

theorem flipped_resolution_thm₂ : ∀ {A C : Prop}, ¬ A → (A ∨ C) → C := λ na orac =>
  match orac with
  | Or.inl a => False.elim (na a)
  | Or.inr c => c

theorem resolution_thm₃ : ∀ {A B: Prop}, (A ∨ B) → ¬ A → B := λ orab na =>
  match orab with
  | Or.inl a => False.elim (na a)
  | Or.inr b => b

theorem flipped_resolution_thm₃ : ∀ {A B : Prop}, (¬ A ∨ B) → A → B := λ ornab a =>
  match ornab with
  | Or.inl na => False.elim (na a)
  | Or.inr b => b

theorem resolution_thm₄ : ∀ {A : Prop}, A → ¬ A → False := λ a na => na a
theorem flipped_resolution_thm₄ : ∀ {A : Prop}, ¬ A → A → False := flip resolution_thm₄

def resolutionCore (firstHyp secondHyp : Ident) (pivotTerm : Term)
  (oSufIdx₁ oSufIdx₂ : Option Nat) (flipped : Bool) : TacticM Unit := do
  let notPivot : Term := Syntax.mkApp (mkIdent `Not) #[pivotTerm]
  let mut resolvantOne  ← elabTerm pivotTerm none
  let mut resolvantTwo  ← elabTerm notPivot none
  let firstHypType  ← inferType (← elabTerm firstHyp none)
  let secondHypType ← inferType (← elabTerm secondHyp none)

  let sufIdx₁ : Nat :=
    match oSufIdx₁ with
    | none   => getLength firstHypType - 1
    | some i => i

  let sufIdx₂ : Nat :=
    match oSufIdx₂ with
    | none   => getLength secondHypType - 1
    | some i => i

  if flipped then
    let tmp      := resolvantOne
    resolvantOne := resolvantTwo
    resolvantTwo := tmp

  let len₁ := sufIdx₁ + 1
  let len₂ := sufIdx₂ + 1
  let prefixLength := len₁ - 2

  let fident1 ← mkIdent <$> mkFreshId
  let fident2 ← mkIdent <$> mkFreshId
  pullCore resolvantOne firstHypType  firstHyp  fident1 oSufIdx₁
  pullCore resolvantTwo secondHypType secondHyp fident2 oSufIdx₂

  let lenGoal := len₁ + len₂ - 2
  if lenGoal > prefixLength + 1 then
    for s in getCongAssoc prefixLength `orAssocConv do
      evalTactic (← `(tactic| apply $s))
      /- logInfo m!"....apply {s}" -/
      /- printGoal -/

  -- we could simplify if we knew how to concatenate two Names
  let thmName : Name :=
    match Nat.blt 1 len₁, Nat.blt 1 len₂ with
    | true, true   => if flipped then `flipped_resolution_thm  else `resolution_thm
    | true, false  => if flipped then `flipped_resolution_thm₃ else `resolution_thm₃
    | false, true  => if flipped then `flipped_resolution_thm₂ else `resolution_thm₂
    | false, false => if flipped then `flipped_resolution_thm₄ else `resolution_thm₄

  let thm := mkIdent thmName

  /- logInfo m!"....closing goal with: {thm}" -/
  let proof := ⟨Syntax.mkApp ⟨thm⟩ #[fident1, fident2]⟩
  evalTactic (← `(tactic| exact $proof))

syntax (name := resolution_1) "R1" ident "," ident "," term (",")? ("[" term,* "]")? : tactic
syntax (name := resolution_2) "R2" ident "," ident "," term (",")? ("[" term,* "]")? : tactic

def parseResolution : Syntax → TacticM (Option Nat × Option Nat)
  | `(tactic| R1 $_, $_, $_, [ $[$hs],* ]) => get hs
  | `(tactic| R1 $_, $_, $_)               => pure (none, none)
  | `(tactic| R2 $_, $_, $_, [ $[$hs],* ]) => get hs
  | `(tactic| R2 $_, $_, $_)               => pure (none, none)
  | _ => throwError "[Resolution]: wrong usage"
where
  get (hs : Array Term) : TacticM (Option Nat × Option Nat) :=
    match hs.toList with
      | [n₁, n₂] => do
        let e₁ ← elabTerm n₁ none
        let e₂ ← elabTerm n₂ none
        return (getNatLit? e₁, getNatLit? e₂)
      | _ => throwError "[Resolution]: wrong usage"

@[tactic resolution_1] def evalResolution_1 : Tactic := fun stx =>
  withMainContext do
    let firstHyp : Ident := ⟨stx[1]⟩
    let secondHyp : Ident := ⟨stx[3]⟩
    let pivotTerm : Term := ⟨stx[5]⟩
    let (sufIdx₁, sufIdx₂) ← parseResolution stx
    resolutionCore firstHyp secondHyp pivotTerm sufIdx₁ sufIdx₂ false

@[tactic resolution_2] def evalResolution_2 : Tactic := fun stx =>
  withMainContext do
    let firstHyp : Ident := ⟨stx[1]⟩
    let secondHyp : Ident := ⟨stx[3]⟩
    let pivotTerm : Term := ⟨stx[5]⟩
    let (sufIdx₁, sufIdx₂) ← parseResolution stx
    resolutionCore firstHyp secondHyp pivotTerm sufIdx₁ sufIdx₂ true

example : A ∨ B ∨ C ∨ D → E ∨ F ∨ ¬ B ∨ H → A ∨ (C ∨ D) ∨ E ∨ F ∨ H := by
  intros h₁ h₂
  R1 h₁, h₂, B, [2, -1]

example : ¬ (A ∧ B) ∨ C ∨ ¬ D ∨ ¬ A → A ∨ ¬ (A ∧ B) → ¬ (A ∧ B) ∨ C ∨ ¬ D ∨ ¬ (A ∧ B) := by
  intros h₁ h₂
  R2 h₁, h₂, A

example : Eq @Eq @Eq := rfl

end Smt.Reconstruction.Certifying


/-
Copyright (c) 2020 Anne Baanen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Nathaniel Thomas, Jeremy Avigad, Johannes Hölzl, Mario Carneiro, Anne Baanen
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.group.hom
import Mathlib.algebra.module.basic
import Mathlib.algebra.group_action_hom
import Mathlib.PostPort

universes u v w l x u_1 u_2 y z

namespace Mathlib

/-!
# Linear maps and linear equivalences

In this file we define

* `linear_map R M M₂`, `M →ₗ[R] M₂` : a linear map between two R-`semimodule`s.

* `is_linear_map R f` : predicate saying that `f : M → M₂` is a linear map.

* `linear_equiv R M ₂`, `M ≃ₗ[R] M₂`: an invertible linear map

## Tags

linear map, linear equiv, linear equivalences, linear isomorphism, linear isomorphic
-/

/-- A map `f` between semimodules over a semiring is linear if it satisfies the two properties
`f (x + y) = f x + f y` and `f (c • x) = c • f x`. The predicate `is_linear_map R f` asserts this
property. A bundled version is available with `linear_map`, and should be favored over
`is_linear_map` most of the time. -/
structure is_linear_map (R : Type u) {M : Type v} {M₂ : Type w} [semiring R] [add_comm_monoid M]
    [add_comm_monoid M₂] [semimodule R M] [semimodule R M₂] (f : M → M₂)
    where
  map_add : ∀ (x y : M), f (x + y) = f x + f y
  map_smul : ∀ (c : R) (x : M), f (c • x) = c • f x

/-- A map `f` between semimodules over a semiring is linear if it satisfies the two properties
`f (x + y) = f x + f y` and `f (c • x) = c • f x`. Elements of `linear_map R M M₂` (available under
the notation `M →ₗ[R] M₂`) are bundled versions of such maps. An unbundled version is available with
the predicate `is_linear_map`, but it should be avoided most of the time. -/
structure linear_map (R : Type u) (M : Type v) (M₂ : Type w) [semiring R] [add_comm_monoid M]
    [add_comm_monoid M₂] [semimodule R M] [semimodule R M₂]
    extends mul_action_hom R M M₂, add_hom M M₂ where

/-- The `add_hom` underlying a `linear_map`. -/
/-- The `mul_action_hom` underlying a `linear_map`. -/
namespace linear_map

protected instance has_coe_to_fun {R : Type u} {M : Type w} {M₂ : Type x} [semiring R]
    [add_comm_monoid M] [add_comm_monoid M₂] [semimodule R M] [semimodule R M₂] :
    has_coe_to_fun (linear_map R M M₂) :=
  has_coe_to_fun.mk (fun (x : linear_map R M M₂) => M → M₂) to_fun

@[simp] theorem coe_mk {R : Type u} {M : Type w} {M₂ : Type x} [semiring R] [add_comm_monoid M]
    [add_comm_monoid M₂] [semimodule R M] [semimodule R M₂] (f : M → M₂)
    (h₁ : ∀ (x y : M), f (x + y) = f x + f y) (h₂ : ∀ (m : R) (x : M), f (m • x) = m • f x) :
    ⇑(mk f h₁ h₂) = f :=
  rfl

/-- Identity map as a `linear_map` -/
def id {R : Type u} {M : Type w} [semiring R] [add_comm_monoid M] [semimodule R M] :
    linear_map R M M :=
  mk id sorry sorry

theorem id_apply {R : Type u} {M : Type w} [semiring R] [add_comm_monoid M] [semimodule R M]
    (x : M) : coe_fn id x = x :=
  rfl

@[simp] theorem id_coe {R : Type u} {M : Type w} [semiring R] [add_comm_monoid M] [semimodule R M] :
    ⇑id = id :=
  funext fun (x : M) => Eq.refl (coe_fn id x)

@[simp] theorem to_fun_eq_coe {R : Type u} {M : Type w} {M₂ : Type x} [semiring R]
    [add_comm_monoid M] [add_comm_monoid M₂] [semimodule R M] [semimodule R M₂]
    (f : linear_map R M M₂) : to_fun f = ⇑f :=
  rfl

theorem is_linear {R : Type u} {M : Type w} {M₂ : Type x} [semiring R] [add_comm_monoid M]
    [add_comm_monoid M₂] [semimodule R M] [semimodule R M₂] (f : linear_map R M M₂) :
    is_linear_map R ⇑f :=
  is_linear_map.mk (map_add' f) (map_smul' f)

theorem coe_injective {R : Type u} {M : Type w} {M₂ : Type x} [semiring R] [add_comm_monoid M]
    [add_comm_monoid M₂] [semimodule R M] [semimodule R M₂] :
    function.injective fun (f : linear_map R M M₂) => (fun (this : M → M₂) => this) ⇑f :=
  sorry

theorem ext {R : Type u} {M : Type w} {M₂ : Type x} [semiring R] [add_comm_monoid M]
    [add_comm_monoid M₂] [semimodule R M] [semimodule R M₂] {f : linear_map R M M₂}
    {g : linear_map R M M₂} (H : ∀ (x : M), coe_fn f x = coe_fn g x) : f = g :=
  coe_injective (funext H)

protected theorem congr_arg {R : Type u} {M : Type w} {M₂ : Type x} [semiring R] [add_comm_monoid M]
    [add_comm_monoid M₂] [semimodule R M] [semimodule R M₂] {f : linear_map R M M₂} {x : M}
    {x' : M} : x = x' → coe_fn f x = coe_fn f x' :=
  sorry

/-- If two linear maps are equal, they are equal at each point. -/
protected theorem congr_fun {R : Type u} {M : Type w} {M₂ : Type x} [semiring R] [add_comm_monoid M]
    [add_comm_monoid M₂] [semimodule R M] [semimodule R M₂] {f : linear_map R M M₂}
    {g : linear_map R M M₂} (h : f = g) (x : M) : coe_fn f x = coe_fn g x :=
  h ▸ rfl

theorem ext_iff {R : Type u} {M : Type w} {M₂ : Type x} [semiring R] [add_comm_monoid M]
    [add_comm_monoid M₂] [semimodule R M] [semimodule R M₂] {f : linear_map R M M₂}
    {g : linear_map R M M₂} : f = g ↔ ∀ (x : M), coe_fn f x = coe_fn g x :=
  { mp := fun (ᾰ : f = g) (x : M) => Eq._oldrec (Eq.refl (coe_fn f x)) ᾰ, mpr := ext }

@[simp] theorem mk_coe {R : Type u} {M : Type w} {M₂ : Type x} [semiring R] [add_comm_monoid M]
    [add_comm_monoid M₂] [semimodule R M] [semimodule R M₂] (f : linear_map R M M₂)
    (h₁ : ∀ (x y : M), coe_fn f (x + y) = coe_fn f x + coe_fn f y)
    (h₂ : ∀ (m : R) (x : M), coe_fn f (m • x) = m • coe_fn f x) : mk (⇑f) h₁ h₂ = f :=
  ext fun (_x : M) => rfl

@[simp] theorem map_add {R : Type u} {M : Type w} {M₂ : Type x} [semiring R] [add_comm_monoid M]
    [add_comm_monoid M₂] [semimodule R M] [semimodule R M₂] (f : linear_map R M M₂) (x : M)
    (y : M) : coe_fn f (x + y) = coe_fn f x + coe_fn f y :=
  map_add' f x y

@[simp] theorem map_smul {R : Type u} {M : Type w} {M₂ : Type x} [semiring R] [add_comm_monoid M]
    [add_comm_monoid M₂] [semimodule R M] [semimodule R M₂] (f : linear_map R M M₂) (c : R)
    (x : M) : coe_fn f (c • x) = c • coe_fn f x :=
  map_smul' f c x

@[simp] theorem map_zero {R : Type u} {M : Type w} {M₂ : Type x} [semiring R] [add_comm_monoid M]
    [add_comm_monoid M₂] [semimodule R M] [semimodule R M₂] (f : linear_map R M M₂) :
    coe_fn f 0 = 0 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (coe_fn f 0 = 0)) (Eq.symm (zero_smul R 0))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (coe_fn f (0 • 0) = 0)) (map_smul f 0 0)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (0 • coe_fn f 0 = 0)) (zero_smul R (coe_fn f 0))))
        (Eq.refl 0)))

/--
A typeclass for `has_scalar` structures which can be moved through a `linear_map`.
This typeclass is generated automatically from a `is_scalar_tower` instance, but exists so that
we can also add an instance for `add_comm_group.int_module`, allowing `z •` to be moved even if
`R` does not support negation.
-/
class compatible_smul (M : Type w) (M₂ : Type x) [add_comm_monoid M] [add_comm_monoid M₂]
    (R : Type u_1) (S : Type u_2) [semiring S] [has_scalar R M] [semimodule S M] [has_scalar R M₂]
    [semimodule S M₂]
    where
  map_smul : ∀ (f : linear_map S M M₂) (c : R) (x : M), coe_fn f (c • x) = c • coe_fn f x

protected instance compatible_smul.is_scalar_tower {M : Type w} {M₂ : Type x} [add_comm_monoid M]
    [add_comm_monoid M₂] {R : Type u_1} {S : Type u_2} [semiring S] [has_scalar R S]
    [has_scalar R M] [semimodule S M] [is_scalar_tower R S M] [has_scalar R M₂] [semimodule S M₂]
    [is_scalar_tower R S M₂] : compatible_smul M M₂ R S :=
  compatible_smul.mk sorry

@[simp] theorem map_smul_of_tower {M : Type w} {M₂ : Type x} [add_comm_monoid M]
    [add_comm_monoid M₂] {R : Type u_1} {S : Type u_2} [semiring S] [has_scalar R M]
    [semimodule S M] [has_scalar R M₂] [semimodule S M₂] [compatible_smul M M₂ R S]
    (f : linear_map S M M₂) (c : R) (x : M) : coe_fn f (c • x) = c • coe_fn f x :=
  compatible_smul.map_smul f c x

protected instance is_add_monoid_hom {R : Type u} {M : Type w} {M₂ : Type x} [semiring R]
    [add_comm_monoid M] [add_comm_monoid M₂] [semimodule R M] [semimodule R M₂]
    (f : linear_map R M M₂) : is_add_monoid_hom ⇑f :=
  is_add_monoid_hom.mk (map_zero f)

/-- convert a linear map to an additive map -/
def to_add_monoid_hom {R : Type u} {M : Type w} {M₂ : Type x} [semiring R] [add_comm_monoid M]
    [add_comm_monoid M₂] [semimodule R M] [semimodule R M₂] (f : linear_map R M M₂) : M →+ M₂ :=
  add_monoid_hom.mk (⇑f) (map_zero f) (map_add f)

@[simp] theorem to_add_monoid_hom_coe {R : Type u} {M : Type w} {M₂ : Type x} [semiring R]
    [add_comm_monoid M] [add_comm_monoid M₂] [semimodule R M] [semimodule R M₂]
    (f : linear_map R M M₂) : ⇑(to_add_monoid_hom f) = ⇑f :=
  rfl

/-- If `M` and `M₂` are both `R`-semimodules and `S`-semimodules and `R`-semimodule structures
are defined by an action of `R` on `S` (formally, we have two scalar towers), then any `S`-linear
map from `M` to `M₂` is `R`-linear.

See also `linear_map.map_smul_of_tower`. -/
def restrict_scalars (R : Type u) {M : Type w} {M₂ : Type x} [semiring R] [add_comm_monoid M]
    [add_comm_monoid M₂] [semimodule R M] [semimodule R M₂] {S : Type u_1} [semiring S]
    [semimodule S M] [semimodule S M₂] [compatible_smul M M₂ R S] (f : linear_map S M M₂) :
    linear_map R M M₂ :=
  mk (⇑f) (map_add f) sorry

@[simp] theorem map_sum {R : Type u} {M : Type w} {M₂ : Type x} [semiring R] [add_comm_monoid M]
    [add_comm_monoid M₂] [semimodule R M] [semimodule R M₂] (f : linear_map R M M₂) {ι : Type u_1}
    {t : finset ι} {g : ι → M} :
    coe_fn f (finset.sum t fun (i : ι) => g i) = finset.sum t fun (i : ι) => coe_fn f (g i) :=
  add_monoid_hom.map_sum (to_add_monoid_hom f) (fun (i : ι) => g i) t

theorem to_add_monoid_hom_injective {R : Type u} {M : Type w} {M₂ : Type x} [semiring R]
    [add_comm_monoid M] [add_comm_monoid M₂] [semimodule R M] [semimodule R M₂] :
    function.injective to_add_monoid_hom :=
  fun (f g : linear_map R M M₂) (h : to_add_monoid_hom f = to_add_monoid_hom g) =>
    ext (add_monoid_hom.congr_fun h)

/-- If two `R`-linear maps from `R` are equal on `1`, then they are equal. -/
theorem ext_ring {R : Type u} {M : Type w} [semiring R] [add_comm_monoid M] [semimodule R M]
    {f : linear_map R R M} {g : linear_map R R M} (h : coe_fn f 1 = coe_fn g 1) : f = g :=
  sorry

/-- Composition of two linear maps is a linear map -/
def comp {R : Type u} {M : Type w} {M₂ : Type x} {M₃ : Type y} [semiring R] [add_comm_monoid M]
    [add_comm_monoid M₂] [add_comm_monoid M₃] {semimodule_M : semimodule R M}
    {semimodule_M₂ : semimodule R M₂} {semimodule_M₃ : semimodule R M₃} (f : linear_map R M₂ M₃)
    (g : linear_map R M M₂) : linear_map R M M₃ :=
  mk (⇑f ∘ ⇑g) sorry sorry

@[simp] theorem comp_apply {R : Type u} {M : Type w} {M₂ : Type x} {M₃ : Type y} [semiring R]
    [add_comm_monoid M] [add_comm_monoid M₂] [add_comm_monoid M₃] {semimodule_M : semimodule R M}
    {semimodule_M₂ : semimodule R M₂} {semimodule_M₃ : semimodule R M₃} (f : linear_map R M₂ M₃)
    (g : linear_map R M M₂) (x : M) : coe_fn (comp f g) x = coe_fn f (coe_fn g x) :=
  rfl

theorem comp_coe {R : Type u} {M : Type w} {M₂ : Type x} {M₃ : Type y} [semiring R]
    [add_comm_monoid M] [add_comm_monoid M₂] [add_comm_monoid M₃] {semimodule_M : semimodule R M}
    {semimodule_M₂ : semimodule R M₂} {semimodule_M₃ : semimodule R M₃} (f : linear_map R M₂ M₃)
    (g : linear_map R M M₂) : ⇑f ∘ ⇑g = ⇑(comp f g) :=
  rfl

/-- If a function `g` is a left and right inverse of a linear map `f`, then `g` is linear itself. -/
def inverse {R : Type u} {M : Type w} {M₂ : Type x} [semiring R] [add_comm_monoid M]
    [add_comm_monoid M₂] [semimodule R M] [semimodule R M₂] (f : linear_map R M M₂) (g : M₂ → M)
    (h₁ : function.left_inverse g ⇑f) (h₂ : function.right_inverse g ⇑f) : linear_map R M₂ M :=
  id
    (fun (h₂ : ∀ (x : M₂), coe_fn f (g x) = x) =>
      id (fun (h₁ : ∀ (x : M), g (coe_fn f x) = x) => mk g sorry sorry) h₁)
    h₂

@[simp] theorem map_neg {R : Type u} {M : Type w} {M₂ : Type x} [semiring R] [add_comm_group M]
    [add_comm_group M₂] {semimodule_M : semimodule R M} {semimodule_M₂ : semimodule R M₂}
    (f : linear_map R M M₂) (x : M) : coe_fn f (-x) = -coe_fn f x :=
  add_monoid_hom.map_neg (to_add_monoid_hom f) x

@[simp] theorem map_sub {R : Type u} {M : Type w} {M₂ : Type x} [semiring R] [add_comm_group M]
    [add_comm_group M₂] {semimodule_M : semimodule R M} {semimodule_M₂ : semimodule R M₂}
    (f : linear_map R M M₂) (x : M) (y : M) : coe_fn f (x - y) = coe_fn f x - coe_fn f y :=
  add_monoid_hom.map_sub (to_add_monoid_hom f) x y

protected instance is_add_group_hom {R : Type u} {M : Type w} {M₂ : Type x} [semiring R]
    [add_comm_group M] [add_comm_group M₂] {semimodule_M : semimodule R M}
    {semimodule_M₂ : semimodule R M₂} (f : linear_map R M M₂) : is_add_group_hom ⇑f :=
  is_add_group_hom.mk

protected instance compatible_smul.int_module {M : Type w} {M₂ : Type x} [add_comm_group M]
    [add_comm_group M₂] {S : Type u_1} [semiring S] [semimodule ℤ M] [semimodule S M]
    [semimodule ℤ M₂] [semimodule S M₂] : compatible_smul M M₂ ℤ S :=
  compatible_smul.mk sorry

end linear_map

namespace is_linear_map

/-- Convert an `is_linear_map` predicate to a `linear_map` -/
def mk' {R : Type u} {M : Type w} {M₂ : Type x} [semiring R] [add_comm_monoid M]
    [add_comm_monoid M₂] [semimodule R M] [semimodule R M₂] (f : M → M₂) (H : is_linear_map R f) :
    linear_map R M M₂ :=
  linear_map.mk f (map_add H) (map_smul H)

@[simp] theorem mk'_apply {R : Type u} {M : Type w} {M₂ : Type x} [semiring R] [add_comm_monoid M]
    [add_comm_monoid M₂] [semimodule R M] [semimodule R M₂] {f : M → M₂} (H : is_linear_map R f)
    (x : M) : coe_fn (mk' f H) x = f x :=
  rfl

theorem is_linear_map_smul {R : Type u_1} {M : Type u_2} [comm_semiring R] [add_comm_monoid M]
    [semimodule R M] (c : R) : is_linear_map R fun (z : M) => c • z :=
  sorry

theorem is_linear_map_smul' {R : Type u_1} {M : Type u_2} [semiring R] [add_comm_monoid M]
    [semimodule R M] (a : M) : is_linear_map R fun (c : R) => c • a :=
  mk (fun (x y : R) => add_smul x y a) fun (x y : R) => mul_smul x y a

theorem map_zero {R : Type u} {M : Type w} {M₂ : Type x} [semiring R] [add_comm_monoid M]
    [add_comm_monoid M₂] [semimodule R M] [semimodule R M₂] {f : M → M₂} (lin : is_linear_map R f) :
    f 0 = 0 :=
  linear_map.map_zero (mk' f lin)

theorem is_linear_map_neg {R : Type u} {M : Type w} [semiring R] [add_comm_group M]
    [semimodule R M] : is_linear_map R fun (z : M) => -z :=
  mk neg_add fun (x : R) (y : M) => Eq.symm (smul_neg x y)

theorem map_neg {R : Type u} {M : Type w} {M₂ : Type x} [semiring R] [add_comm_group M]
    [add_comm_group M₂] [semimodule R M] [semimodule R M₂] {f : M → M₂} (lin : is_linear_map R f)
    (x : M) : f (-x) = -f x :=
  linear_map.map_neg (mk' f lin) x

theorem map_sub {R : Type u} {M : Type w} {M₂ : Type x} [semiring R] [add_comm_group M]
    [add_comm_group M₂] [semimodule R M] [semimodule R M₂] {f : M → M₂} (lin : is_linear_map R f)
    (x : M) (y : M) : f (x - y) = f x - f y :=
  linear_map.map_sub (mk' f lin) x y

end is_linear_map

/-- Linear endomorphisms of a module, with associated ring structure
`linear_map.endomorphism_semiring` and algebra structure `module.endomorphism_algebra`. -/
def module.End (R : Type u) (M : Type v) [semiring R] [add_comm_monoid M] [semimodule R M] :=
  linear_map R M M

/-- Reinterpret an additive homomorphism as a `ℤ`-linear map. -/
def add_monoid_hom.to_int_linear_map {M : Type w} {M₂ : Type x} [add_comm_group M]
    [add_comm_group M₂] (f : M →+ M₂) : linear_map ℤ M M₂ :=
  linear_map.mk ⇑f sorry sorry

/-- Reinterpret an additive homomorphism as a `ℚ`-linear map. -/
def add_monoid_hom.to_rat_linear_map {M : Type w} {M₂ : Type x} [add_comm_group M]
    [vector_space ℚ M] [add_comm_group M₂] [vector_space ℚ M₂] (f : M →+ M₂) : linear_map ℚ M M₂ :=
  linear_map.mk (add_monoid_hom.to_fun f) sorry (add_monoid_hom.map_rat_module_smul f)

/-! ### Linear equivalences -/

/-- A linear equivalence is an invertible linear map. -/
structure linear_equiv (R : Type u) (M : Type v) (M₂ : Type w) [semiring R] [add_comm_monoid M]
    [add_comm_monoid M₂] [semimodule R M] [semimodule R M₂]
    extends M ≃+ M₂, linear_map R M M₂ where

namespace linear_equiv

-- see Note [function coercion]

protected instance linear_map.has_coe {R : Type u} {M : Type w} {M₂ : Type x} [semiring R]
    [add_comm_monoid M] [add_comm_monoid M₂] [semimodule R M] [semimodule R M₂] :
    has_coe (linear_equiv R M M₂) (linear_map R M M₂) :=
  has_coe.mk to_linear_map

protected instance has_coe_to_fun {R : Type u} {M : Type w} {M₂ : Type x} [semiring R]
    [add_comm_monoid M] [add_comm_monoid M₂] [semimodule R M] [semimodule R M₂] :
    has_coe_to_fun (linear_equiv R M M₂) :=
  has_coe_to_fun.mk (fun (f : linear_equiv R M M₂) => M → M₂)
    fun (f : linear_equiv R M M₂) => to_fun f

@[simp] theorem mk_apply {R : Type u} {M : Type w} {M₂ : Type x} [semiring R] [add_comm_monoid M]
    [add_comm_monoid M₂] [semimodule R M] [semimodule R M₂] {to_fun : M → M₂} {inv_fun : M₂ → M}
    {map_add : ∀ (x y : M), to_fun (x + y) = to_fun x + to_fun y}
    {map_smul : ∀ (m : R) (x : M), to_fun (m • x) = m • to_fun x}
    {left_inv : function.left_inverse inv_fun to_fun}
    {right_inv : function.right_inverse inv_fun to_fun} {a : M} :
    coe_fn (mk to_fun map_add map_smul inv_fun left_inv right_inv) a = to_fun a :=
  rfl

-- This exists for compatibility, previously `≃ₗ[R]` extended `≃` instead of `≃+`.

def to_equiv {R : Type u} {M : Type w} {M₂ : Type x} [semiring R] [add_comm_monoid M]
    [add_comm_monoid M₂] [semimodule R M] [semimodule R M₂] : linear_equiv R M M₂ → M ≃ M₂ :=
  fun (f : linear_equiv R M M₂) => add_equiv.to_equiv (to_add_equiv f)

theorem injective_to_equiv {R : Type u} {M : Type w} {M₂ : Type x} [semiring R] [add_comm_monoid M]
    [add_comm_monoid M₂] [semimodule R M] [semimodule R M₂] : function.injective to_equiv :=
  sorry

@[simp] theorem to_equiv_inj {R : Type u} {M : Type w} {M₂ : Type x} [semiring R]
    [add_comm_monoid M] [add_comm_monoid M₂] [semimodule R M] [semimodule R M₂]
    {e₁ : linear_equiv R M M₂} {e₂ : linear_equiv R M M₂} : to_equiv e₁ = to_equiv e₂ ↔ e₁ = e₂ :=
  function.injective.eq_iff injective_to_equiv

theorem injective_to_linear_map {R : Type u} {M : Type w} {M₂ : Type x} [semiring R]
    [add_comm_monoid M] [add_comm_monoid M₂] [semimodule R M] [semimodule R M₂] :
    function.injective coe :=
  fun (e₁ e₂ : linear_equiv R M M₂) (H : ↑e₁ = ↑e₂) =>
    injective_to_equiv (equiv.ext (linear_map.congr_fun H))

@[simp] theorem to_linear_map_inj {R : Type u} {M : Type w} {M₂ : Type x} [semiring R]
    [add_comm_monoid M] [add_comm_monoid M₂] [semimodule R M] [semimodule R M₂]
    {e₁ : linear_equiv R M M₂} {e₂ : linear_equiv R M M₂} : ↑e₁ = ↑e₂ ↔ e₁ = e₂ :=
  function.injective.eq_iff injective_to_linear_map

@[simp] theorem coe_coe {R : Type u} {M : Type w} {M₂ : Type x} [semiring R] [add_comm_monoid M]
    [add_comm_monoid M₂] {semimodule_M : semimodule R M} {semimodule_M₂ : semimodule R M₂}
    (e : linear_equiv R M M₂) : ⇑↑e = ⇑e :=
  rfl

@[simp] theorem coe_to_equiv {R : Type u} {M : Type w} {M₂ : Type x} [semiring R]
    [add_comm_monoid M] [add_comm_monoid M₂] {semimodule_M : semimodule R M}
    {semimodule_M₂ : semimodule R M₂} (e : linear_equiv R M M₂) : ⇑(to_equiv e) = ⇑e :=
  rfl

@[simp] theorem to_fun_apply {R : Type u} {M : Type w} {M₂ : Type x} [semiring R]
    [add_comm_monoid M] [add_comm_monoid M₂] {semimodule_M : semimodule R M}
    {semimodule_M₂ : semimodule R M₂} (e : linear_equiv R M M₂) {m : M} : to_fun e m = coe_fn e m :=
  rfl

theorem ext {R : Type u} {M : Type w} {M₂ : Type x} [semiring R] [add_comm_monoid M]
    [add_comm_monoid M₂] {semimodule_M : semimodule R M} {semimodule_M₂ : semimodule R M₂}
    {e : linear_equiv R M M₂} {e' : linear_equiv R M M₂} (h : ∀ (x : M), coe_fn e x = coe_fn e' x) :
    e = e' :=
  injective_to_equiv (equiv.ext h)

protected theorem congr_arg {R : Type u} {M : Type w} {M₂ : Type x} [semiring R] [add_comm_monoid M]
    [add_comm_monoid M₂] {semimodule_M : semimodule R M} {semimodule_M₂ : semimodule R M₂}
    {e : linear_equiv R M M₂} {x : M} {x' : M} : x = x' → coe_fn e x = coe_fn e x' :=
  sorry

protected theorem congr_fun {R : Type u} {M : Type w} {M₂ : Type x} [semiring R] [add_comm_monoid M]
    [add_comm_monoid M₂] {semimodule_M : semimodule R M} {semimodule_M₂ : semimodule R M₂}
    {e : linear_equiv R M M₂} {e' : linear_equiv R M M₂} (h : e = e') (x : M) :
    coe_fn e x = coe_fn e' x :=
  h ▸ rfl

theorem ext_iff {R : Type u} {M : Type w} {M₂ : Type x} [semiring R] [add_comm_monoid M]
    [add_comm_monoid M₂] {semimodule_M : semimodule R M} {semimodule_M₂ : semimodule R M₂}
    {e : linear_equiv R M M₂} {e' : linear_equiv R M M₂} :
    e = e' ↔ ∀ (x : M), coe_fn e x = coe_fn e' x :=
  { mp := fun (h : e = e') (x : M) => h ▸ rfl, mpr := ext }

/-- The identity map is a linear equivalence. -/
def refl (R : Type u) (M : Type w) [semiring R] [add_comm_monoid M] [semimodule R M] :
    linear_equiv R M M :=
  mk (linear_map.to_fun linear_map.id) sorry sorry (equiv.inv_fun (equiv.refl M)) sorry sorry

@[simp] theorem refl_apply {R : Type u} {M : Type w} [semiring R] [add_comm_monoid M]
    [semimodule R M] (x : M) : coe_fn (refl R M) x = x :=
  rfl

/-- Linear equivalences are symmetric. -/
def symm {R : Type u} {M : Type w} {M₂ : Type x} [semiring R] [add_comm_monoid M]
    [add_comm_monoid M₂] {semimodule_M : semimodule R M} {semimodule_M₂ : semimodule R M₂}
    (e : linear_equiv R M M₂) : linear_equiv R M₂ M :=
  mk
    (linear_map.to_fun
      (linear_map.inverse (to_linear_map e) (inv_fun e) (left_inv e) (right_inv e)))
    sorry sorry (equiv.inv_fun (equiv.symm (to_equiv e))) sorry sorry

/-- See Note [custom simps projection] -/
def simps.inv_fun {R : Type u} {M : Type w} {M₂ : Type x} [semiring R] [add_comm_monoid M]
    [add_comm_monoid M₂] [semimodule R M] [semimodule R M₂] (e : linear_equiv R M M₂) : M₂ → M :=
  ⇑(symm e)

@[simp] theorem inv_fun_eq_symm {R : Type u} {M : Type w} {M₂ : Type x} [semiring R]
    [add_comm_monoid M] [add_comm_monoid M₂] {semimodule_M : semimodule R M}
    {semimodule_M₂ : semimodule R M₂} (e : linear_equiv R M M₂) : inv_fun e = ⇑(symm e) :=
  rfl

/-- Linear equivalences are transitive. -/
def trans {R : Type u} {M : Type w} {M₂ : Type x} {M₃ : Type y} [semiring R] [add_comm_monoid M]
    [add_comm_monoid M₂] [add_comm_monoid M₃] {semimodule_M : semimodule R M}
    {semimodule_M₂ : semimodule R M₂} {semimodule_M₃ : semimodule R M₃} (e₁ : linear_equiv R M M₂)
    (e₂ : linear_equiv R M₂ M₃) : linear_equiv R M M₃ :=
  mk (linear_map.to_fun (linear_map.comp (to_linear_map e₂) (to_linear_map e₁))) sorry sorry
    (equiv.inv_fun (equiv.trans (to_equiv e₁) (to_equiv e₂))) sorry sorry

@[simp] theorem coe_to_add_equiv {R : Type u} {M : Type w} {M₂ : Type x} [semiring R]
    [add_comm_monoid M] [add_comm_monoid M₂] {semimodule_M : semimodule R M}
    {semimodule_M₂ : semimodule R M₂} (e : linear_equiv R M M₂) : ⇑(to_add_equiv e) = ⇑e :=
  rfl

@[simp] theorem trans_apply {R : Type u} {M : Type w} {M₂ : Type x} {M₃ : Type y} [semiring R]
    [add_comm_monoid M] [add_comm_monoid M₂] [add_comm_monoid M₃] {semimodule_M : semimodule R M}
    {semimodule_M₂ : semimodule R M₂} {semimodule_M₃ : semimodule R M₃} (e₁ : linear_equiv R M M₂)
    (e₂ : linear_equiv R M₂ M₃) (c : M) : coe_fn (trans e₁ e₂) c = coe_fn e₂ (coe_fn e₁ c) :=
  rfl

@[simp] theorem apply_symm_apply {R : Type u} {M : Type w} {M₂ : Type x} [semiring R]
    [add_comm_monoid M] [add_comm_monoid M₂] {semimodule_M : semimodule R M}
    {semimodule_M₂ : semimodule R M₂} (e : linear_equiv R M M₂) (c : M₂) :
    coe_fn e (coe_fn (symm e) c) = c :=
  right_inv e c

@[simp] theorem symm_apply_apply {R : Type u} {M : Type w} {M₂ : Type x} [semiring R]
    [add_comm_monoid M] [add_comm_monoid M₂] {semimodule_M : semimodule R M}
    {semimodule_M₂ : semimodule R M₂} (e : linear_equiv R M M₂) (b : M) :
    coe_fn (symm e) (coe_fn e b) = b :=
  left_inv e b

@[simp] theorem symm_trans_apply {R : Type u} {M : Type w} {M₂ : Type x} {M₃ : Type y} [semiring R]
    [add_comm_monoid M] [add_comm_monoid M₂] [add_comm_monoid M₃] {semimodule_M : semimodule R M}
    {semimodule_M₂ : semimodule R M₂} {semimodule_M₃ : semimodule R M₃} (e₁ : linear_equiv R M M₂)
    (e₂ : linear_equiv R M₂ M₃) (c : M₃) :
    coe_fn (symm (trans e₁ e₂)) c = coe_fn (symm e₁) (coe_fn (symm e₂) c) :=
  rfl

@[simp] theorem trans_refl {R : Type u} {M : Type w} {M₂ : Type x} [semiring R] [add_comm_monoid M]
    [add_comm_monoid M₂] {semimodule_M : semimodule R M} {semimodule_M₂ : semimodule R M₂}
    (e : linear_equiv R M M₂) : trans e (refl R M₂) = e :=
  injective_to_equiv (equiv.trans_refl (to_equiv e))

@[simp] theorem refl_trans {R : Type u} {M : Type w} {M₂ : Type x} [semiring R] [add_comm_monoid M]
    [add_comm_monoid M₂] {semimodule_M : semimodule R M} {semimodule_M₂ : semimodule R M₂}
    (e : linear_equiv R M M₂) : trans (refl R M) e = e :=
  injective_to_equiv (equiv.refl_trans (to_equiv e))

theorem symm_apply_eq {R : Type u} {M : Type w} {M₂ : Type x} [semiring R] [add_comm_monoid M]
    [add_comm_monoid M₂] {semimodule_M : semimodule R M} {semimodule_M₂ : semimodule R M₂}
    (e : linear_equiv R M M₂) {x : M₂} {y : M} : coe_fn (symm e) x = y ↔ x = coe_fn e y :=
  equiv.symm_apply_eq (to_equiv e)

theorem eq_symm_apply {R : Type u} {M : Type w} {M₂ : Type x} [semiring R] [add_comm_monoid M]
    [add_comm_monoid M₂] {semimodule_M : semimodule R M} {semimodule_M₂ : semimodule R M₂}
    (e : linear_equiv R M M₂) {x : M₂} {y : M} : y = coe_fn (symm e) x ↔ coe_fn e y = x :=
  equiv.eq_symm_apply (to_equiv e)

@[simp] theorem trans_symm {R : Type u} {M : Type w} {M₂ : Type x} [semiring R] [add_comm_monoid M]
    [add_comm_monoid M₂] [semimodule R M] [semimodule R M₂] (f : linear_equiv R M M₂) :
    trans f (symm f) = refl R M :=
  sorry

@[simp] theorem symm_trans {R : Type u} {M : Type w} {M₂ : Type x} [semiring R] [add_comm_monoid M]
    [add_comm_monoid M₂] [semimodule R M] [semimodule R M₂] (f : linear_equiv R M M₂) :
    trans (symm f) f = refl R M₂ :=
  sorry

@[simp] theorem refl_to_linear_map {R : Type u} {M : Type w} [semiring R] [add_comm_monoid M]
    [semimodule R M] : ↑(refl R M) = linear_map.id :=
  rfl

@[simp] theorem comp_coe {R : Type u} {M : Type w} {M₂ : Type x} {M₃ : Type y} [semiring R]
    [add_comm_monoid M] [add_comm_monoid M₂] [add_comm_monoid M₃] [semimodule R M] [semimodule R M₂]
    [semimodule R M₃] (f : linear_equiv R M M₂) (f' : linear_equiv R M₂ M₃) :
    linear_map.comp ↑f' ↑f = ↑(trans f f') :=
  rfl

@[simp] theorem map_add {R : Type u} {M : Type w} {M₂ : Type x} [semiring R] [add_comm_monoid M]
    [add_comm_monoid M₂] {semimodule_M : semimodule R M} {semimodule_M₂ : semimodule R M₂}
    (e : linear_equiv R M M₂) (a : M) (b : M) : coe_fn e (a + b) = coe_fn e a + coe_fn e b :=
  map_add' e a b

@[simp] theorem map_zero {R : Type u} {M : Type w} {M₂ : Type x} [semiring R] [add_comm_monoid M]
    [add_comm_monoid M₂] {semimodule_M : semimodule R M} {semimodule_M₂ : semimodule R M₂}
    (e : linear_equiv R M M₂) : coe_fn e 0 = 0 :=
  linear_map.map_zero (to_linear_map e)

@[simp] theorem map_smul {R : Type u} {M : Type w} {M₂ : Type x} [semiring R] [add_comm_monoid M]
    [add_comm_monoid M₂] {semimodule_M : semimodule R M} {semimodule_M₂ : semimodule R M₂}
    (e : linear_equiv R M M₂) (c : R) (x : M) : coe_fn e (c • x) = c • coe_fn e x :=
  map_smul' e c x

@[simp] theorem map_sum {R : Type u} {M : Type w} {M₂ : Type x} {ι : Type z} [semiring R]
    [add_comm_monoid M] [add_comm_monoid M₂] {semimodule_M : semimodule R M}
    {semimodule_M₂ : semimodule R M₂} (e : linear_equiv R M M₂) {s : finset ι} (u : ι → M) :
    coe_fn e (finset.sum s fun (i : ι) => u i) = finset.sum s fun (i : ι) => coe_fn e (u i) :=
  linear_map.map_sum (to_linear_map e)

@[simp] theorem map_eq_zero_iff {R : Type u} {M : Type w} {M₂ : Type x} [semiring R]
    [add_comm_monoid M] [add_comm_monoid M₂] {semimodule_M : semimodule R M}
    {semimodule_M₂ : semimodule R M₂} (e : linear_equiv R M M₂) {x : M} : coe_fn e x = 0 ↔ x = 0 :=
  add_equiv.map_eq_zero_iff (to_add_equiv e)

theorem map_ne_zero_iff {R : Type u} {M : Type w} {M₂ : Type x} [semiring R] [add_comm_monoid M]
    [add_comm_monoid M₂] {semimodule_M : semimodule R M} {semimodule_M₂ : semimodule R M₂}
    (e : linear_equiv R M M₂) {x : M} : coe_fn e x ≠ 0 ↔ x ≠ 0 :=
  add_equiv.map_ne_zero_iff (to_add_equiv e)

@[simp] theorem symm_symm {R : Type u} {M : Type w} {M₂ : Type x} [semiring R] [add_comm_monoid M]
    [add_comm_monoid M₂] {semimodule_M : semimodule R M} {semimodule_M₂ : semimodule R M₂}
    (e : linear_equiv R M M₂) : symm (symm e) = e :=
  sorry

protected theorem bijective {R : Type u} {M : Type w} {M₂ : Type x} [semiring R] [add_comm_monoid M]
    [add_comm_monoid M₂] {semimodule_M : semimodule R M} {semimodule_M₂ : semimodule R M₂}
    (e : linear_equiv R M M₂) : function.bijective ⇑e :=
  equiv.bijective (to_equiv e)

protected theorem injective {R : Type u} {M : Type w} {M₂ : Type x} [semiring R] [add_comm_monoid M]
    [add_comm_monoid M₂] {semimodule_M : semimodule R M} {semimodule_M₂ : semimodule R M₂}
    (e : linear_equiv R M M₂) : function.injective ⇑e :=
  equiv.injective (to_equiv e)

protected theorem surjective {R : Type u} {M : Type w} {M₂ : Type x} [semiring R]
    [add_comm_monoid M] [add_comm_monoid M₂] {semimodule_M : semimodule R M}
    {semimodule_M₂ : semimodule R M₂} (e : linear_equiv R M M₂) : function.surjective ⇑e :=
  equiv.surjective (to_equiv e)

protected theorem image_eq_preimage {R : Type u} {M : Type w} {M₂ : Type x} [semiring R]
    [add_comm_monoid M] [add_comm_monoid M₂] {semimodule_M : semimodule R M}
    {semimodule_M₂ : semimodule R M₂} (e : linear_equiv R M M₂) (s : set M) :
    ⇑e '' s = ⇑(symm e) ⁻¹' s :=
  equiv.image_eq_preimage (to_equiv e) s

/-- An involutive linear map is a linear equivalence. -/
def of_involutive {R : Type u} {M : Type w} [semiring R] [add_comm_monoid M] [semimodule R M]
    (f : linear_map R M M) (hf : function.involutive ⇑f) : linear_equiv R M M :=
  mk (linear_map.to_fun f) (linear_map.map_add' f) (linear_map.map_smul' f)
    (equiv.inv_fun (function.involutive.to_equiv (⇑f) hf)) sorry sorry

@[simp] theorem coe_of_involutive {R : Type u} {M : Type w} [semiring R] [add_comm_monoid M]
    [semimodule R M] (f : linear_map R M M) (hf : function.involutive ⇑f) :
    ⇑(of_involutive f hf) = ⇑f :=
  rfl

end Mathlib


import data.real.basic
import algebra.big_operators.intervals
import measure_theory.measurable_space
import topology.basic
import measure_theory.borel_space
import analysis.special_functions.exp_log

import ODE_enclosures.affine_arithmetic
import ODE_enclosures.float

noncomputable theory

open set topological_space finsupp real

open_locale big_operators classical

-- Following https://www.isa-afp.org/browser_info/current/AFP/Affine_Arithmetic/document.pdf.
section affine_arithmetic_with_error

-- TODO: Is it OK to work over ℝ? Yes for now, but how easy is it to generalise?
structure affine_form_with_error extends affine_form ℝ :=
(error : ℝ)

namespace affine_form_with_error

variable (n : ℕ)

variables {E : Type*} [normed_group E] [normed_space ℝ E]

section operations

-- TODO: Move.
lemma truncate_with_error_zero_fst (p : ℕ)
: (prod.fst ∘ truncate_with_error p) 0 = 0 :=
by simp [truncate_with_error, truncate_down_zero]

-- Def trunc-bound-pdevs (p. 152)
def truncate_partials_with_error (p : ℕ) (x : ℕ →₀ ℝ) : (ℕ →₀ ℝ) × ℝ :=
⟨map_range (prod.fst ∘ truncate_with_error p) (truncate_with_error_zero_fst p) x,
∑ i in x.support, abs ((truncate_with_error p (x i)).1 - (x i))⟩

-- Def add-aform' (p. 160)
def add_with_error (p : ℕ) (A₁ A₂ : affine_form_with_error) : affine_form_with_error :=
let z₀ := truncate_with_error p (A₁.x₀ + A₂.x₀),
    z  := truncate_partials_with_error p (A₁.x + A₂.x) in
{ x₀    := z₀.1,
  x     := z.1,
  error := z₀.2 + z.2 + abs A₁.error + abs A₂.error }
-- Is this different from adding a fresh noise symbol with the error?

end operations

end affine_form_with_error

end affine_arithmetic_with_error