import Lean4Axiomatic.AbstractAlgebra
import Lean4Axiomatic.Integer.Core

/-! # Integer addition -/

namespace Lean4Axiomatic.Integer

/-! ## Axioms -/

/--
Definition of addition, and properties that it must satisfy.

All other properties of addition can be derived from these.

**Named parameters**
- `ℤ`: The type of integers.

**Class parameters**
- `Core ℤ`: Required to express most properties of addition.
-/
class Addition {ℕ : outParam Type} [Natural ℕ] (ℤ : Type) [Core (ℕ := ℕ) ℤ] :=
  /-- Definition of and syntax for addition. -/
  addOp : Add ℤ

  /--
  Addition preserves equivalence of integers; two equivalent integers are still
  equivalent after the same quantity is added to both (on the left or right).
  -/
  add_substitutive : AA.Substitutive₂ (α := ℤ) (· + ·) AA.tc (· ≃ ·) (· ≃ ·)

  /-- Exchanging the operands of an addition does not change the result. -/
  add_commutative : AA.Commutative (α := ℤ) (· + ·)

  /-- The grouping of the terms in a sum doesn't matter. -/
  add_associative : AA.Associative (α := ℤ) (· + ·)

  /-- Adding zero to an integer produces the same integer. -/
  add_identity : AA.Identity (α := ℤ) 0 (· + ·)

  /--
  Adding two natural numbers and then converting to an integer gives the same
  result as converting each number to an integer and then adding.
  -/
  add_compatible_from_natural
    : AA.Compatible₂ (α := ℕ) (β := ℤ) (↑·) (· + ·) (· + ·)

attribute [instance] Addition.addOp
attribute [instance] Addition.add_associative
attribute [instance] Addition.add_commutative
attribute [instance] Addition.add_compatible_from_natural
attribute [instance] Addition.add_identity
attribute [instance] Addition.add_substitutive

export Addition (addOp)

/-! ## Derived properties -/

variable {ℕ : Type} [Natural ℕ]
variable {ℤ : Type} [Core ℤ] [Addition (ℕ := ℕ) ℤ]

/--
Non-typeclass version of `add_associative`.

Eventually, this should become the axiom and the typeclass should be derived.
-/
theorem add_assoc {a b c : ℤ} : (a + b) + c ≃ a + (b + c) := AA.assoc

end Lean4Axiomatic.Integer


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

! This file was ported from Lean 3 source module category_theory.abelian.pseudoelements
! leanprover-community/mathlib commit 70fd9563a21e7b963887c9360bd29b2393e6225a
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.CategoryTheory.Abelian.Exact
import Mathbin.CategoryTheory.Over
import Mathbin.Algebra.Category.Module.EpiMono

/-!
# Pseudoelements in abelian categories

A *pseudoelement* of an object `X` in an abelian category `C` is an equivalence class of arrows
ending in `X`, where two arrows are considered equivalent if we can find two epimorphisms with a
common domain making a commutative square with the two arrows. While the construction shows that
pseudoelements are actually subobjects of `X` rather than "elements", it is possible to chase these
pseudoelements through commutative diagrams in an abelian category to prove exactness properties.
This is done using some "diagram-chasing metatheorems" proved in this file. In many cases, a proof
in the category of abelian groups can more or less directly be converted into a proof using
pseudoelements.

A classic application of pseudoelements are diagram lemmas like the four lemma or the snake lemma.

Pseudoelements are in some ways weaker than actual elements in a concrete category. The most
important limitation is that there is no extensionality principle: If `f g : X ⟶ Y`, then
`∀ x ∈ X, f x = g x` does not necessarily imply that `f = g` (however, if `f = 0` or `g = 0`,
it does). A corollary of this is that we can not define arrows in abelian categories by dictating
their action on pseudoelements. Thus, a usual style of proofs in abelian categories is this:
First, we construct some morphism using universal properties, and then we use diagram chasing
of pseudoelements to verify that is has some desirable property such as exactness.

It should be noted that the Freyd-Mitchell embedding theorem gives a vastly stronger notion of
pseudoelement (in particular one that gives extensionality). However, this theorem is quite
difficult to prove and probably out of reach for a formal proof for the time being.

## Main results

We define the type of pseudoelements of an object and, in particular, the zero pseudoelement.

We prove that every morphism maps the zero pseudoelement to the zero pseudoelement (`apply_zero`)
and that a zero morphism maps every pseudoelement to the zero pseudoelement (`zero_apply`)

Here are the metatheorems we provide:
* A morphism `f` is zero if and only if it is the zero function on pseudoelements.
* A morphism `f` is an epimorphism if and only if it is surjective on pseudoelements.
* A morphism `f` is a monomorphism if and only if it is injective on pseudoelements
  if and only if `∀ a, f a = 0 → f = 0`.
* A sequence `f, g` of morphisms is exact if and only if
  `∀ a, g (f a) = 0` and `∀ b, g b = 0 → ∃ a, f a = b`.
* If `f` is a morphism and `a, a'` are such that `f a = f a'`, then there is some
  pseudoelement `a''` such that `f a'' = 0` and for every `g` we have
  `g a' = 0 → g a = g a''`. We can think of `a''` as `a - a'`, but don't get too carried away
  by that: pseudoelements of an object do not form an abelian group.

## Notations

We introduce coercions from an object of an abelian category to the set of its pseudoelements
and from a morphism to the function it induces on pseudoelements.

These coercions must be explicitly enabled via local instances:
`local attribute [instance] object_to_sort hom_to_fun`

## Implementation notes

It appears that sometimes the coercion from morphisms to functions does not work, i.e.,
writing `g a` raises a "function expected" error. This error can be fixed by writing
`(g : X ⟶ Y) a`.

## References

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

open CategoryTheory

open CategoryTheory.Limits

open CategoryTheory.Abelian

open CategoryTheory.Preadditive

universe v u

namespace CategoryTheory.Abelian

variable {C : Type u} [Category.{v} C]

attribute [local instance] over.coe_from_hom

/-- This is just composition of morphisms in `C`. Another way to express this would be
    `(over.map f).obj a`, but our definition has nicer definitional properties. -/
def app {P Q : C} (f : P ⟶ Q) (a : Over P) : Over Q :=
  a.Hom ≫ f
#align category_theory.abelian.app CategoryTheory.Abelian.app

@[simp]
theorem app_hom {P Q : C} (f : P ⟶ Q) (a : Over P) : (app f a).Hom = a.Hom ≫ f :=
  rfl
#align category_theory.abelian.app_hom CategoryTheory.Abelian.app_hom

/-- Two arrows `f : X ⟶ P` and `g : Y ⟶ P` are called pseudo-equal if there is some object
    `R` and epimorphisms `p : R ⟶ X` and `q : R ⟶ Y` such that `p ≫ f = q ≫ g`. -/
def PseudoEqual (P : C) (f g : Over P) : Prop :=
  ∃ (R : C)(p : R ⟶ f.1)(q : R ⟶ g.1)(_ : Epi p)(_ : Epi q), p ≫ f.Hom = q ≫ g.Hom
#align category_theory.abelian.pseudo_equal CategoryTheory.Abelian.PseudoEqual

theorem pseudoEqual_refl {P : C} : Reflexive (PseudoEqual P) := fun f =>
  ⟨f.1, 𝟙 f.1, 𝟙 f.1, by infer_instance, by infer_instance, by simp⟩
#align category_theory.abelian.pseudo_equal_refl CategoryTheory.Abelian.pseudoEqual_refl

theorem pseudoEqual_symm {P : C} : Symmetric (PseudoEqual P) := fun f g ⟨R, p, q, ep, Eq, comm⟩ =>
  ⟨R, q, p, Eq, ep, comm.symm⟩
#align category_theory.abelian.pseudo_equal_symm CategoryTheory.Abelian.pseudoEqual_symm

variable [Abelian.{v} C]

section

/-- Pseudoequality is transitive: Just take the pullback. The pullback morphisms will
    be epimorphisms since in an abelian category, pullbacks of epimorphisms are epimorphisms. -/
theorem pseudoEqual_trans {P : C} : Transitive (PseudoEqual P) :=
  fun f g h ⟨R, p, q, ep, Eq, comm⟩ ⟨R', p', q', ep', eq', comm'⟩ =>
  by
  refine' ⟨pullback q p', pullback.fst ≫ p, pullback.snd ≫ q', _, _, _⟩
  · skip
    exact epi_comp _ _
  · skip
    exact epi_comp _ _
  ·
    rw [category.assoc, comm, ← category.assoc, pullback.condition, category.assoc, comm',
      category.assoc]
#align category_theory.abelian.pseudo_equal_trans CategoryTheory.Abelian.pseudoEqual_trans

end

/-- The arrows with codomain `P` equipped with the equivalence relation of being pseudo-equal. -/
def Pseudoelement.setoid (P : C) : Setoid (Over P) :=
  ⟨_, ⟨pseudoEqual_refl, pseudoEqual_symm, pseudoEqual_trans⟩⟩
#align category_theory.abelian.pseudoelement.setoid CategoryTheory.Abelian.Pseudoelement.setoid

attribute [local instance] pseudoelement.setoid

/-- A `pseudoelement` of `P` is just an equivalence class of arrows ending in `P` by being
    pseudo-equal. -/
def Pseudoelement (P : C) : Type max u v :=
  Quotient (Pseudoelement.setoid P)
#align category_theory.abelian.pseudoelement CategoryTheory.Abelian.Pseudoelement

namespace Pseudoelement

/-- A coercion from an object of an abelian category to its pseudoelements. -/
def objectToSort : CoeSort C (Type max u v) :=
  ⟨fun P => Pseudoelement P⟩
#align category_theory.abelian.pseudoelement.object_to_sort CategoryTheory.Abelian.Pseudoelement.objectToSort

attribute [local instance] object_to_sort

scoped[Pseudoelement] attribute [instance] CategoryTheory.Abelian.Pseudoelement.objectToSort

/-- A coercion from an arrow with codomain `P` to its associated pseudoelement. -/
def overToSort {P : C} : Coe (Over P) (Pseudoelement P) :=
  ⟨Quot.mk (PseudoEqual P)⟩
#align category_theory.abelian.pseudoelement.over_to_sort CategoryTheory.Abelian.Pseudoelement.overToSort

attribute [local instance] over_to_sort

theorem over_coe_def {P Q : C} (a : Q ⟶ P) : (a : Pseudoelement P) = ⟦a⟧ :=
  rfl
#align category_theory.abelian.pseudoelement.over_coe_def CategoryTheory.Abelian.Pseudoelement.over_coe_def

/-- If two elements are pseudo-equal, then their composition with a morphism is, too. -/
theorem pseudo_apply_aux {P Q : C} (f : P ⟶ Q) (a b : Over P) : a ≈ b → app f a ≈ app f b :=
  fun ⟨R, p, q, ep, Eq, comm⟩ =>
  ⟨R, p, q, ep, Eq, show p ≫ a.Hom ≫ f = q ≫ b.Hom ≫ f by rw [reassoc_of comm]⟩
#align category_theory.abelian.pseudoelement.pseudo_apply_aux CategoryTheory.Abelian.Pseudoelement.pseudo_apply_aux

/-- A morphism `f` induces a function `pseudo_apply f` on pseudoelements. -/
def pseudoApply {P Q : C} (f : P ⟶ Q) : P → Q :=
  Quotient.map (fun g : Over P => app f g) (pseudo_apply_aux f)
#align category_theory.abelian.pseudoelement.pseudo_apply CategoryTheory.Abelian.Pseudoelement.pseudoApply

/-- A coercion from morphisms to functions on pseudoelements -/
def homToFun {P Q : C} : CoeFun (P ⟶ Q) fun _ => P → Q :=
  ⟨pseudoApply⟩
#align category_theory.abelian.pseudoelement.hom_to_fun CategoryTheory.Abelian.Pseudoelement.homToFun

attribute [local instance] hom_to_fun

scoped[Pseudoelement] attribute [instance] CategoryTheory.Abelian.Pseudoelement.homToFun

theorem pseudo_apply_mk' {P Q : C} (f : P ⟶ Q) (a : Over P) : f ⟦a⟧ = ⟦a.Hom ≫ f⟧ :=
  rfl
#align category_theory.abelian.pseudoelement.pseudo_apply_mk CategoryTheory.Abelian.Pseudoelement.pseudo_apply_mk'

/-- Applying a pseudoelement to a composition of morphisms is the same as composing
    with each morphism. Sadly, this is not a definitional equality, but at least it is
    true. -/
theorem comp_apply {P Q R : C} (f : P ⟶ Q) (g : Q ⟶ R) (a : P) : (f ≫ g) a = g (f a) :=
  Quotient.inductionOn a fun x =>
    Quotient.sound <| by
      unfold app
      rw [← category.assoc, over.coe_hom]
#align category_theory.abelian.pseudoelement.comp_apply CategoryTheory.Abelian.Pseudoelement.comp_apply

/-- Composition of functions on pseudoelements is composition of morphisms. -/
theorem comp_comp {P Q R : C} (f : P ⟶ Q) (g : Q ⟶ R) : g ∘ f = f ≫ g :=
  funext fun x => (comp_apply _ _ _).symm
#align category_theory.abelian.pseudoelement.comp_comp CategoryTheory.Abelian.Pseudoelement.comp_comp

section Zero

/-!
In this section we prove that for every `P` there is an equivalence class that contains
precisely all the zero morphisms ending in `P` and use this to define *the* zero
pseudoelement.
-/

section

attribute [local instance] has_binary_biproducts.of_has_binary_products

/-- The arrows pseudo-equal to a zero morphism are precisely the zero morphisms -/
theorem pseudo_zero_aux {P : C} (Q : C) (f : Over P) : f ≈ (0 : Q ⟶ P) ↔ f.Hom = 0 :=
  ⟨fun ⟨R, p, q, ep, Eq, comm⟩ => zero_of_epi_comp p (by simp [comm]), fun hf =>
    ⟨biprod f.1 Q, biprod.fst, biprod.snd, by infer_instance, by infer_instance, by
      rw [hf, over.coe_hom, has_zero_morphisms.comp_zero, has_zero_morphisms.comp_zero]⟩⟩
#align category_theory.abelian.pseudoelement.pseudo_zero_aux CategoryTheory.Abelian.Pseudoelement.pseudo_zero_aux

end

theorem zero_eq_zero' {P Q R : C} : ⟦((0 : Q ⟶ P) : Over P)⟧ = ⟦((0 : R ⟶ P) : Over P)⟧ :=
  Quotient.sound <| (pseudo_zero_aux R _).2 rfl
#align category_theory.abelian.pseudoelement.zero_eq_zero' CategoryTheory.Abelian.Pseudoelement.zero_eq_zero'

/-- The zero pseudoelement is the class of a zero morphism -/
def pseudoZero {P : C} : P :=
  ⟦(0 : P ⟶ P)⟧
#align category_theory.abelian.pseudoelement.pseudo_zero CategoryTheory.Abelian.Pseudoelement.pseudoZero

/-- We can not use `pseudo_zero` as a global `has_zero` instance,
as it would trigger on any type class search for `has_zero` applied to a `coe_sort`.
This would be too expensive.
-/
def hasZero {P : C} : Zero P :=
  ⟨pseudoZero⟩
#align category_theory.abelian.pseudoelement.has_zero CategoryTheory.Abelian.Pseudoelement.hasZero

scoped[Pseudoelement] attribute [instance] CategoryTheory.Abelian.Pseudoelement.hasZero

instance {P : C} : Inhabited (Pseudoelement P) :=
  ⟨0⟩

theorem pseudo_zero_def {P : C} : (0 : Pseudoelement P) = ⟦(0 : P ⟶ P)⟧ :=
  rfl
#align category_theory.abelian.pseudoelement.pseudo_zero_def CategoryTheory.Abelian.Pseudoelement.pseudo_zero_def

@[simp]
theorem zero_eq_zero {P Q : C} : ⟦((0 : Q ⟶ P) : Over P)⟧ = (0 : Pseudoelement P) :=
  zero_eq_zero'
#align category_theory.abelian.pseudoelement.zero_eq_zero CategoryTheory.Abelian.Pseudoelement.zero_eq_zero

/-- The pseudoelement induced by an arrow is zero precisely when that arrow is zero -/
theorem pseudo_zero_iff {P : C} (a : Over P) : (a : P) = 0 ↔ a.Hom = 0 :=
  by
  rw [← pseudo_zero_aux P a]
  exact Quotient.eq'
#align category_theory.abelian.pseudoelement.pseudo_zero_iff CategoryTheory.Abelian.Pseudoelement.pseudo_zero_iff

end Zero

open Pseudoelement

/-- Morphisms map the zero pseudoelement to the zero pseudoelement -/
@[simp]
theorem apply_zero {P Q : C} (f : P ⟶ Q) : f 0 = 0 :=
  by
  rw [pseudo_zero_def, pseudo_apply_mk]
  simp
#align category_theory.abelian.pseudoelement.apply_zero CategoryTheory.Abelian.Pseudoelement.apply_zero

/-- The zero morphism maps every pseudoelement to 0. -/
@[simp]
theorem zero_apply {P : C} (Q : C) (a : P) : (0 : P ⟶ Q) a = 0 :=
  Quotient.inductionOn a fun a' =>
    by
    rw [pseudo_zero_def, pseudo_apply_mk]
    simp
#align category_theory.abelian.pseudoelement.zero_apply CategoryTheory.Abelian.Pseudoelement.zero_apply

/-- An extensionality lemma for being the zero arrow. -/
theorem zero_morphism_ext {P Q : C} (f : P ⟶ Q) : (∀ a, f a = 0) → f = 0 := fun h =>
  by
  rw [← category.id_comp f]
  exact (pseudo_zero_iff (𝟙 P ≫ f : over Q)).1 (h (𝟙 P))
#align category_theory.abelian.pseudoelement.zero_morphism_ext CategoryTheory.Abelian.Pseudoelement.zero_morphism_ext

theorem zero_morphism_ext' {P Q : C} (f : P ⟶ Q) : (∀ a, f a = 0) → 0 = f :=
  Eq.symm ∘ zero_morphism_ext f
#align category_theory.abelian.pseudoelement.zero_morphism_ext' CategoryTheory.Abelian.Pseudoelement.zero_morphism_ext'

scoped[Pseudoelement]
  attribute [ext]
    CategoryTheory.Abelian.Pseudoelement.zero_morphism_ext CategoryTheory.Abelian.Pseudoelement.zero_morphism_ext'

theorem eq_zero_iff {P Q : C} (f : P ⟶ Q) : f = 0 ↔ ∀ a, f a = 0 :=
  ⟨fun h a => by simp [h], zero_morphism_ext _⟩
#align category_theory.abelian.pseudoelement.eq_zero_iff CategoryTheory.Abelian.Pseudoelement.eq_zero_iff

/-- A monomorphism is injective on pseudoelements. -/
theorem pseudo_injective_of_mono {P Q : C} (f : P ⟶ Q) [Mono f] : Function.Injective f :=
  fun abar abar' =>
  Quotient.induction_on₂ abar abar' fun a a' ha =>
    Quotient.sound <|
      have : ⟦(a.Hom ≫ f : Over Q)⟧ = ⟦a'.Hom ≫ f⟧ := by convert ha
      match Quotient.exact this with
      | ⟨R, p, q, ep, Eq, comm⟩ =>
        ⟨R, p, q, ep, Eq,
          (cancel_mono f).1 <| by
            simp only [category.assoc]
            exact comm⟩
#align category_theory.abelian.pseudoelement.pseudo_injective_of_mono CategoryTheory.Abelian.Pseudoelement.pseudo_injective_of_mono

/-- A morphism that is injective on pseudoelements only maps the zero element to zero. -/
theorem zero_of_map_zero {P Q : C} (f : P ⟶ Q) : Function.Injective f → ∀ a, f a = 0 → a = 0 :=
  fun h a ha => by
  rw [← apply_zero f] at ha
  exact h ha
#align category_theory.abelian.pseudoelement.zero_of_map_zero CategoryTheory.Abelian.Pseudoelement.zero_of_map_zero

/-- A morphism that only maps the zero pseudoelement to zero is a monomorphism. -/
theorem mono_of_zero_of_map_zero {P Q : C} (f : P ⟶ Q) : (∀ a, f a = 0 → a = 0) → Mono f := fun h =>
  (mono_iff_cancel_zero _).2 fun R g hg =>
    (pseudo_zero_iff (g : Over P)).1 <|
      h _ <| show f g = 0 from (pseudo_zero_iff (g ≫ f : Over Q)).2 hg
#align category_theory.abelian.pseudoelement.mono_of_zero_of_map_zero CategoryTheory.Abelian.Pseudoelement.mono_of_zero_of_map_zero

section

/-- An epimorphism is surjective on pseudoelements. -/
theorem pseudo_surjective_of_epi {P Q : C} (f : P ⟶ Q) [Epi f] : Function.Surjective f :=
  fun qbar =>
  Quotient.inductionOn qbar fun q =>
    ⟨((pullback.fst : pullback f q.Hom ⟶ P) : Over P),
      Quotient.sound <|
        ⟨pullback f q.Hom, 𝟙 (pullback f q.Hom), pullback.snd, by infer_instance, by infer_instance,
          by rw [category.id_comp, ← pullback.condition, app_hom, over.coe_hom]⟩⟩
#align category_theory.abelian.pseudoelement.pseudo_surjective_of_epi CategoryTheory.Abelian.Pseudoelement.pseudo_surjective_of_epi

end

/-- A morphism that is surjective on pseudoelements is an epimorphism. -/
theorem epi_of_pseudo_surjective {P Q : C} (f : P ⟶ Q) : Function.Surjective f → Epi f := fun h =>
  match h (𝟙 Q) with
  | ⟨pbar, hpbar⟩ =>
    match Quotient.exists_rep pbar with
    | ⟨p, hp⟩ =>
      have : ⟦(p.Hom ≫ f : Over Q)⟧ = ⟦𝟙 Q⟧ :=
        by
        rw [← hp] at hpbar
        exact hpbar
      match Quotient.exact this with
      | ⟨R, x, y, ex, ey, comm⟩ =>
        @epi_of_epi_fac _ _ _ _ _ (x ≫ p.Hom) f y ey <|
          by
          dsimp at comm
          rw [category.assoc, comm]
          apply category.comp_id
#align category_theory.abelian.pseudoelement.epi_of_pseudo_surjective CategoryTheory.Abelian.Pseudoelement.epi_of_pseudo_surjective

section

/-- Two morphisms in an exact sequence are exact on pseudoelements. -/
theorem pseudo_exact_of_exact {P Q R : C} {f : P ⟶ Q} {g : Q ⟶ R} (h : Exact f g) :
    (∀ a, g (f a) = 0) ∧ ∀ b, g b = 0 → ∃ a, f a = b :=
  ⟨fun a => by
    rw [← comp_apply, h.w]
    exact zero_apply _ _, fun b' =>
    Quotient.inductionOn b' fun b hb =>
      by
      have hb' : b.Hom ≫ g = 0 := (pseudo_zero_iff _).1 hb
      -- By exactness, b factors through im f = ker g via some c
      obtain ⟨c, hc⟩ := kernel_fork.is_limit.lift' (is_limit_image f g h) _ hb'
      -- We compute the pullback of the map into the image and c.
      -- The pseudoelement induced by the first pullback map will be our preimage.
      use (pullback.fst : pullback (abelian.factor_thru_image f) c ⟶ P)
      -- It remains to show that the image of this element under f is pseudo-equal to b.
      apply Quotient.sound
      -- pullback.snd is an epimorphism because the map onto the image is!
      refine'
        ⟨pullback (abelian.factor_thru_image f) c, 𝟙 _, pullback.snd, by infer_instance, by
          infer_instance, _⟩
      -- Now we can verify that the diagram commutes.
      calc
        𝟙 (pullback (abelian.factor_thru_image f) c) ≫ pullback.fst ≫ f = pullback.fst ≫ f :=
          category.id_comp _
        _ = pullback.fst ≫ abelian.factor_thru_image f ≫ kernel.ι (cokernel.π f) := by
          rw [abelian.image.fac]
        _ = (pullback.snd ≫ c) ≫ kernel.ι (cokernel.π f) := by
          rw [← category.assoc, pullback.condition]
        _ = pullback.snd ≫ b.hom := by
          rw [category.assoc]
          congr
        ⟩
#align category_theory.abelian.pseudoelement.pseudo_exact_of_exact CategoryTheory.Abelian.Pseudoelement.pseudo_exact_of_exact

end

theorem apply_eq_zero_of_comp_eq_zero {P Q R : C} (f : Q ⟶ R) (a : P ⟶ Q) : a ≫ f = 0 → f a = 0 :=
  fun h => by simp [over_coe_def, pseudo_apply_mk, over.coe_hom, h]
#align category_theory.abelian.pseudoelement.apply_eq_zero_of_comp_eq_zero CategoryTheory.Abelian.Pseudoelement.apply_eq_zero_of_comp_eq_zero

section

/-- If two morphisms are exact on pseudoelements, they are exact. -/
theorem exact_of_pseudo_exact {P Q R : C} (f : P ⟶ Q) (g : Q ⟶ R) :
    ((∀ a, g (f a) = 0) ∧ ∀ b, g b = 0 → ∃ a, f a = b) → Exact f g := fun ⟨h₁, h₂⟩ =>
  (Abelian.exact_iff _ _).2
    ⟨zero_morphism_ext _ fun a => by rw [comp_apply, h₁ a],
      by
      -- If we apply g to the pseudoelement induced by its kernel, we get 0 (of course!).
      have : g (kernel.ι g) = 0 := apply_eq_zero_of_comp_eq_zero _ _ (kernel.condition _)
      -- By pseudo-exactness, we get a preimage.
      obtain ⟨a', ha⟩ := h₂ _ this
      obtain ⟨a, ha'⟩ := Quotient.exists_rep a'
      rw [← ha'] at ha
      obtain ⟨Z, r, q, er, eq, comm⟩ := Quotient.exact ha
      -- Consider the pullback of kernel.ι (cokernel.π f) and kernel.ι g.
      -- The commutative diagram given by the pseudo-equality f a = b induces
      -- a cone over this pullback, so we get a factorization z.
      obtain ⟨z, hz₁, hz₂⟩ :=
        @pullback.lift' _ _ _ _ _ _ (kernel.ι (cokernel.π f)) (kernel.ι g) _
          (r ≫ a.hom ≫ abelian.factor_thru_image f) q
          (by
            simp only [category.assoc, abelian.image.fac]
            exact comm)
      -- Let's give a name to the second pullback morphism.
      let j : pullback (kernel.ι (cokernel.π f)) (kernel.ι g) ⟶ kernel g := pullback.snd
      -- Since q is an epimorphism, in particular this means that j is an epimorphism.
      haveI pe : epi j := epi_of_epi_fac hz₂
      -- But is is also a monomorphism, because kernel.ι (cokernel.π f) is: A kernel is
      -- always a monomorphism and the pullback of a monomorphism is a monomorphism.
      -- But mono + epi = iso, so j is an isomorphism.
      haveI : is_iso j := is_iso_of_mono_of_epi _
      -- But then kernel.ι g can be expressed using all of the maps of the pullback square, and we
      -- are done.
      rw [(iso.eq_inv_comp (as_iso j)).2 pullback.condition.symm]
      simp only [category.assoc, kernel.condition, has_zero_morphisms.comp_zero]⟩
#align category_theory.abelian.pseudoelement.exact_of_pseudo_exact CategoryTheory.Abelian.Pseudoelement.exact_of_pseudo_exact

end

/-- If two pseudoelements `x` and `y` have the same image under some morphism `f`, then we can form
    their "difference" `z`. This pseudoelement has the properties that `f z = 0` and for all
    morphisms `g`, if `g y = 0` then `g z = g x`. -/
theorem sub_of_eq_image {P Q : C} (f : P ⟶ Q) (x y : P) :
    f x = f y → ∃ z, f z = 0 ∧ ∀ (R : C) (g : P ⟶ R), (g : P ⟶ R) y = 0 → g z = g x :=
  Quotient.induction_on₂ x y fun a a' h =>
    match Quotient.exact h with
    | ⟨R, p, q, ep, Eq, comm⟩ =>
      let a'' : R ⟶ P := p ≫ a.Hom - q ≫ a'.Hom
      ⟨a'',
        ⟨show ⟦((p ≫ a.Hom - q ≫ a'.Hom) ≫ f : Over Q)⟧ = ⟦(0 : Q ⟶ Q)⟧
            by
            dsimp at comm
            simp [sub_eq_zero.2 comm],
          fun Z g hh => by
          obtain ⟨X, p', q', ep', eq', comm'⟩ := Quotient.exact hh
          have : a'.hom ≫ g = 0 :=
            by
            apply (epi_iff_cancel_zero _).1 ep' _ (a'.hom ≫ g)
            simpa using comm'
          apply Quotient.sound
          -- Can we prevent quotient.sound from giving us this weird `coe_b` thingy?
          change app g (a'' : over P) ≈ app g a
          exact ⟨R, 𝟙 R, p, by infer_instance, ep, by simp [sub_eq_add_neg, this]⟩⟩⟩
#align category_theory.abelian.pseudoelement.sub_of_eq_image CategoryTheory.Abelian.Pseudoelement.sub_of_eq_image

variable [Limits.HasPullbacks C]

/-- If `f : P ⟶ R` and `g : Q ⟶ R` are morphisms and `p : P` and `q : Q` are pseudoelements such
    that `f p = g q`, then there is some `s : pullback f g` such that `fst s = p` and `snd s = q`.

    Remark: Borceux claims that `s` is unique, but this is false. See
    `counterexamples/pseudoelement` for details. -/
theorem pseudo_pullback {P Q R : C} {f : P ⟶ R} {g : Q ⟶ R} {p : P} {q : Q} :
    f p = g q →
      ∃ s, (pullback.fst : pullback f g ⟶ P) s = p ∧ (pullback.snd : pullback f g ⟶ Q) s = q :=
  Quotient.induction_on₂ p q fun x y h =>
    by
    obtain ⟨Z, a, b, ea, eb, comm⟩ := Quotient.exact h
    obtain ⟨l, hl₁, hl₂⟩ :=
      @pullback.lift' _ _ _ _ _ _ f g _ (a ≫ x.hom) (b ≫ y.hom)
        (by
          simp only [category.assoc]
          exact comm)
    exact
      ⟨l,
        ⟨Quotient.sound ⟨Z, 𝟙 Z, a, by infer_instance, ea, by rwa [category.id_comp]⟩,
          Quotient.sound ⟨Z, 𝟙 Z, b, by infer_instance, eb, by rwa [category.id_comp]⟩⟩⟩
#align category_theory.abelian.pseudoelement.pseudo_pullback CategoryTheory.Abelian.Pseudoelement.pseudo_pullback

section Module

attribute [-instance] hom_to_fun

/-- In the category `Module R`, if `x` and `y` are pseudoequal, then the range of the associated
morphisms is the same. -/
theorem Module.eq_range_of_pseudoequal {R : Type _} [CommRing R] {G : ModuleCat R} {x y : Over G}
    (h : PseudoEqual G x y) : x.Hom.range = y.Hom.range :=
  by
  obtain ⟨P, p, q, hp, hq, H⟩ := h
  refine' Submodule.ext fun a => ⟨fun ha => _, fun ha => _⟩
  · obtain ⟨a', ha'⟩ := ha
    obtain ⟨a'', ha''⟩ := (ModuleCat.epi_iff_surjective p).1 hp a'
    refine' ⟨q a'', _⟩
    rw [← LinearMap.comp_apply, ← ModuleCat.comp_def, ← H, ModuleCat.comp_def, LinearMap.comp_apply,
      ha'', ha']
  · obtain ⟨a', ha'⟩ := ha
    obtain ⟨a'', ha''⟩ := (ModuleCat.epi_iff_surjective q).1 hq a'
    refine' ⟨p a'', _⟩
    rw [← LinearMap.comp_apply, ← ModuleCat.comp_def, H, ModuleCat.comp_def, LinearMap.comp_apply,
      ha'', ha']
#align category_theory.abelian.pseudoelement.Module.eq_range_of_pseudoequal CategoryTheory.Abelian.Pseudoelement.Module.eq_range_of_pseudoequal

end Module

end Pseudoelement

end CategoryTheory.Abelian


/-
Copyright (c) 2018 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro, Johan Commelin
-/
import algebra.hom.equiv
import algebra.ring.basic
import logic.equiv.basic
import logic.equiv.option

/-!
# Adjoining a zero/one to semigroups and related algebraic structures

This file contains different results about adjoining an element to an algebraic structure which then
behaves like a zero or a one. An example is adjoining a one to a semigroup to obtain a monoid. That
this provides an example of an adjunction is proved in `algebra.category.Mon.adjunctions`.

Another result says that adjoining to a group an element `zero` gives a `group_with_zero`. For more
information about these structures (which are not that standard in informal mathematics, see
`algebra.group_with_zero.basic`)
-/

universes u v w
variables {α : Type u} {β : Type v} {γ : Type w}

/-- Add an extra element `1` to a type -/
@[to_additive "Add an extra element `0` to a type"]
def with_one (α) := option α

namespace with_one

instance [has_repr α] : has_repr (with_zero α) :=
⟨λ o, match o with | none := "0" | (some a) := "↑" ++ repr a end⟩

@[to_additive]
instance [has_repr α] : has_repr (with_one α) :=
⟨λ o, match o with | none := "1" | (some a) := "↑" ++ repr a end⟩

@[to_additive]
instance : monad with_one := option.monad

@[to_additive]
instance : has_one (with_one α) := ⟨none⟩

@[to_additive]
instance [has_mul α] : has_mul (with_one α) := ⟨option.lift_or_get (*)⟩

@[to_additive]
instance [has_inv α] : has_inv (with_one α) := ⟨λ a, option.map has_inv.inv a⟩

@[to_additive]
instance : inhabited (with_one α) := ⟨1⟩

@[to_additive]
instance [nonempty α] : nontrivial (with_one α) := option.nontrivial

@[to_additive]
instance : has_coe_t α (with_one α) := ⟨some⟩

@[to_additive]
lemma some_eq_coe {a : α} : (some a : with_one α) = ↑a := rfl

@[simp, to_additive]
lemma coe_ne_one {a : α} : (a : with_one α) ≠ (1 : with_one α) :=
option.some_ne_none a

@[simp, to_additive]
lemma one_ne_coe {a : α} : (1 : with_one α) ≠ a :=
coe_ne_one.symm

@[to_additive]
lemma ne_one_iff_exists {x : with_one α} : x ≠ 1 ↔ ∃ (a : α), ↑a = x :=
option.ne_none_iff_exists

@[to_additive]
instance : can_lift (with_one α) α :=
{ coe := coe,
  cond := λ a, a ≠ 1,
  prf := λ a, ne_one_iff_exists.1 }

@[simp, norm_cast, to_additive]
lemma coe_inj {a b : α} : (a : with_one α) = b ↔ a = b :=
option.some_inj

@[elab_as_eliminator, to_additive]
protected lemma cases_on {P : with_one α → Prop} :
  ∀ (x : with_one α), P 1 → (∀ a : α, P a) → P x :=
option.cases_on

-- the `show` statements in the proofs are important, because otherwise the generated lemmas
-- `with_one.mul_one_class._proof_{1,2}` have an ill-typed statement after `with_one` is made
-- irreducible.
@[to_additive]
instance [has_mul α] : mul_one_class (with_one α) :=
{ mul := (*),
  one := (1),
  one_mul   := show ∀ x : with_one α, 1 * x = x, from (option.lift_or_get_is_left_id _).1,
  mul_one   := show ∀ x : with_one α, x * 1 = x, from (option.lift_or_get_is_right_id _).1 }

@[to_additive]
instance [semigroup α] : monoid (with_one α) :=
{ mul_assoc := (option.lift_or_get_assoc _).1,
  ..with_one.mul_one_class }

example [semigroup α] :
  @monoid.to_mul_one_class _ (@with_one.monoid α _) = @with_one.mul_one_class α _ := rfl

@[to_additive]
instance [comm_semigroup α] : comm_monoid (with_one α) :=
{ mul_comm := (option.lift_or_get_comm _).1,
  ..with_one.monoid }

section
-- workaround: we make `with_one`/`with_zero` irreducible for this definition, otherwise `simps`
-- will unfold it in the statement of the lemma it generates.
local attribute [irreducible] with_one with_zero
/-- `coe` as a bundled morphism -/
@[to_additive "`coe` as a bundled morphism", simps apply]
def coe_mul_hom [has_mul α] : mul_hom α (with_one α) :=
{ to_fun := coe, map_mul' := λ x y, rfl }

end

section lift

variables [has_mul α] [mul_one_class β]

/-- Lift a semigroup homomorphism `f` to a bundled monoid homorphism. -/
@[to_additive "Lift an add_semigroup homomorphism `f` to a bundled add_monoid homorphism."]
def lift : mul_hom α β ≃ (with_one α →* β) :=
{ to_fun := λ f,
  { to_fun := λ x, option.cases_on x 1 f,
    map_one' := rfl,
    map_mul' := λ x y,
      with_one.cases_on x (by { rw one_mul, exact (one_mul _).symm }) $ λ x,
      with_one.cases_on y (by { rw mul_one, exact (mul_one _).symm }) $ λ y,
      f.map_mul x y },
  inv_fun := λ F, F.to_mul_hom.comp coe_mul_hom,
  left_inv := λ f, mul_hom.ext $ λ x, rfl,
  right_inv := λ F, monoid_hom.ext $ λ x, with_one.cases_on x F.map_one.symm $ λ x, rfl }

variables (f : mul_hom α β)

@[simp, to_additive]
lemma lift_coe (x : α) : lift f x = f x := rfl

@[simp, to_additive]
lemma lift_one : lift f 1 = 1 := rfl

@[to_additive]
theorem lift_unique (f : with_one α →* β) : f = lift (f.to_mul_hom.comp coe_mul_hom) :=
(lift.apply_symm_apply f).symm

end lift

attribute [irreducible] with_one

section map

variables [has_mul α] [has_mul β] [has_mul γ]

/-- Given a multiplicative map from `α → β` returns a monoid homomorphism
  from `with_one α` to `with_one β` -/
@[to_additive "Given an additive map from `α → β` returns an add_monoid homomorphism
  from `with_zero α` to `with_zero β`"]
def map (f : mul_hom α β) : with_one α →* with_one β :=
lift (coe_mul_hom.comp f)

@[simp, to_additive] lemma map_coe (f : mul_hom α β) (a : α) : map f (a : with_one α) = f a :=
lift_coe _ _

@[simp, to_additive]
lemma map_id : map (mul_hom.id α) = monoid_hom.id (with_one α) :=
by { ext, induction x using with_one.cases_on; refl }

@[to_additive]
lemma map_map (f : mul_hom α β) (g : mul_hom β γ) (x) :
  map g (map f x) = map (g.comp f) x :=
by { induction x using with_one.cases_on; refl }

@[simp, to_additive]
lemma map_comp (f : mul_hom α β) (g : mul_hom β γ) :
  map (g.comp f) = (map g).comp (map f) :=
monoid_hom.ext $ λ x, (map_map f g x).symm

/-- A version of `equiv.option_congr` for `with_one`. -/
@[to_additive "A version of `equiv.option_congr` for `with_zero`.", simps apply]
def _root_.mul_equiv.with_one_congr (e : α ≃* β) : with_one α ≃* with_one β :=
{ to_fun := map e.to_mul_hom,
  inv_fun := map e.symm.to_mul_hom,
  left_inv := λ x, (map_map _ _ _).trans $ by induction x using with_one.cases_on; { simp },
  right_inv := λ x, (map_map _ _ _).trans $ by induction x using with_one.cases_on; { simp },
  .. map e.to_mul_hom }

@[simp]
lemma _root_.mul_equiv.with_one_congr_refl : (mul_equiv.refl α).with_one_congr = mul_equiv.refl _ :=
mul_equiv.to_monoid_hom_injective map_id

@[simp]
lemma _root_.mul_equiv.with_one_congr_symm (e : α ≃* β) :
  e.with_one_congr.symm = e.symm.with_one_congr := rfl

@[simp]
lemma _root_.mul_equiv.with_one_congr_trans (e₁ : α ≃* β) (e₂ : β ≃* γ) :
  e₁.with_one_congr.trans e₂.with_one_congr = (e₁.trans e₂).with_one_congr :=
mul_equiv.to_monoid_hom_injective (map_comp _ _).symm

end map

@[simp, norm_cast, to_additive]
lemma coe_mul [has_mul α] (a b : α) : ((a * b : α) : with_one α) = a * b := rfl

@[simp, norm_cast, to_additive]
lemma coe_inv [has_inv α] (a : α) : ((a⁻¹ : α) : with_one α) = a⁻¹ := rfl

end with_one

namespace with_zero

instance [one : has_one α] : has_one (with_zero α) :=
{ ..one }

@[simp, norm_cast] lemma coe_one [has_one α] : ((1 : α) : with_zero α) = 1 := rfl

instance [has_mul α] : mul_zero_class (with_zero α) :=
{ mul       := λ o₁ o₂, o₁.bind (λ a, option.map (λ b, a * b) o₂),
  zero_mul  := λ a, rfl,
  mul_zero  := λ a, by cases a; refl,
  ..with_zero.has_zero }

@[simp, norm_cast] lemma coe_mul {α : Type u} [has_mul α]
  {a b : α} : ((a * b : α) : with_zero α) = a * b := rfl

@[simp] lemma zero_mul {α : Type u} [has_mul α]
  (a : with_zero α) : 0 * a = 0 := rfl

@[simp] lemma mul_zero {α : Type u} [has_mul α]
  (a : with_zero α) : a * 0 = 0 := by cases a; refl

instance [semigroup α] : semigroup_with_zero (with_zero α) :=
{ mul_assoc := λ a b c, match a, b, c with
    | none,   _,      _      := rfl
    | some a, none,   _      := rfl
    | some a, some b, none   := rfl
    | some a, some b, some c := congr_arg some (mul_assoc _ _ _)
    end,
  ..with_zero.mul_zero_class }

instance [comm_semigroup α] : comm_semigroup (with_zero α) :=
{ mul_comm := λ a b, match a, b with
    | none,   _      := (mul_zero _).symm
    | some a, none   := rfl
    | some a, some b := congr_arg some (mul_comm _ _)
    end,
  ..with_zero.semigroup_with_zero }

instance [mul_one_class α] : mul_zero_one_class (with_zero α) :=
{ one_mul := λ a, match a with
    | none   := rfl
    | some a := congr_arg some $ one_mul _
    end,
  mul_one := λ a, match a with
    | none   := rfl
    | some a := congr_arg some $ mul_one _
    end,
  ..with_zero.mul_zero_class,
  ..with_zero.has_one }

instance [has_one α] [has_pow α ℕ] : has_pow (with_zero α) ℕ :=
⟨λ x n, match x, n with
  | none, 0 := 1
  | none, n + 1 := 0
  | some x, n := ↑(x ^ n)
  end⟩

@[simp, norm_cast] lemma coe_pow [has_one α] [has_pow α ℕ] {a : α} (n : ℕ) :
  ↑(a ^ n : α) = (↑a ^ n : with_zero α) := rfl

instance [monoid α] : monoid_with_zero (with_zero α) :=
{ npow := λ n x, x ^ n,
  npow_zero' := λ x, match x with
    | none   := rfl
    | some x := congr_arg some $ pow_zero _
    end,
  npow_succ' := λ n x, match x with
    | none   := rfl
    | some x := congr_arg some $ pow_succ _ _
    end,
  .. with_zero.mul_zero_one_class,
  .. with_zero.semigroup_with_zero }

instance [comm_monoid α] : comm_monoid_with_zero (with_zero α) :=
{ ..with_zero.monoid_with_zero, ..with_zero.comm_semigroup }

/-- Given an inverse operation on `α` there is an inverse operation
  on `with_zero α` sending `0` to `0`-/
instance [has_inv α] : has_inv (with_zero α) := ⟨λ a, option.map has_inv.inv a⟩

@[simp, norm_cast] lemma coe_inv [has_inv α] (a : α) :
  ((a⁻¹ : α) : with_zero α) = a⁻¹ := rfl

@[simp] lemma inv_zero [has_inv α] :
  (0 : with_zero α)⁻¹ = 0 := rfl

instance [has_div α] : has_div (with_zero α) :=
⟨λ o₁ o₂, o₁.bind (λ a, option.map (λ b, a / b) o₂)⟩

@[norm_cast] lemma coe_div [has_div α] (a b : α) : ↑(a / b : α) = (a / b : with_zero α) := rfl

instance [has_one α] [has_pow α ℤ] : has_pow (with_zero α) ℤ :=
⟨λ x n, match x, n with
  | none, int.of_nat 0            := 1
  | none, int.of_nat (nat.succ n) := 0
  | none, int.neg_succ_of_nat n   := 0
  | some x, n                     := ↑(x ^ n)
  end⟩

@[simp, norm_cast] lemma coe_zpow [div_inv_monoid α] {a : α} (n : ℤ) :
  ↑(a ^ n : α) = (↑a ^ n : with_zero α) := rfl

instance [div_inv_monoid α] : div_inv_monoid (with_zero α) :=
{ div_eq_mul_inv := λ a b, match a, b with
    | none,   _      := rfl
    | some a, none   := rfl
    | some a, some b := congr_arg some (div_eq_mul_inv _ _)
    end,
  zpow := λ n x, x ^ n,
  zpow_zero' := λ x, match x with
    | none   := rfl
    | some x := congr_arg some $ zpow_zero _
    end,
  zpow_succ' := λ n x, match x with
    | none   := rfl
    | some x := congr_arg some $ div_inv_monoid.zpow_succ' _ _
    end,
  zpow_neg' := λ n x, match x with
    | none   := rfl
    | some x := congr_arg some $ div_inv_monoid.zpow_neg' _ _
    end,
  .. with_zero.has_div,
  .. with_zero.has_inv,
  .. with_zero.monoid_with_zero, }

section group
variables [group α]

@[simp] lemma inv_one : (1 : with_zero α)⁻¹ = 1 :=
show ((1⁻¹ : α) : with_zero α) = 1, by simp

/-- if `G` is a group then `with_zero G` is a group with zero. -/
instance : group_with_zero (with_zero α) :=
{ inv_zero := inv_zero,
  mul_inv_cancel := λ a ha, by { lift a to α using ha, norm_cast, apply mul_right_inv },
  .. with_zero.monoid_with_zero,
  .. with_zero.div_inv_monoid,
  .. with_zero.nontrivial }

end group

instance [comm_group α] : comm_group_with_zero (with_zero α) :=
{ .. with_zero.group_with_zero, .. with_zero.comm_monoid_with_zero }

instance [semiring α] : semiring (with_zero α) :=
{ left_distrib := λ a b c, begin
    cases a with a, {refl},
    cases b with b; cases c with c; try {refl},
    exact congr_arg some (left_distrib _ _ _)
  end,
  right_distrib := λ a b c, begin
    cases c with c,
    { change (a + b) * 0 = a * 0 + b * 0, simp },
    cases a with a; cases b with b; try {refl},
    exact congr_arg some (right_distrib _ _ _)
  end,
  ..with_zero.add_comm_monoid,
  ..with_zero.mul_zero_class,
  ..with_zero.monoid_with_zero }

attribute [irreducible] with_zero

end with_zero


/-
Copyright (c) 2015 Nathaniel Thomas. 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
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.module.linear_map
import Mathlib.group_theory.group_action.sub_mul_action
import Mathlib.PostPort

universes u v l w

namespace Mathlib

/-!

# Submodules of a module

In this file we define

* `submodule R M` : a subset of a `module` `M` that contains zero and is closed with respect to addition and
  scalar multiplication.

* `subspace k M` : an abbreviation for `submodule` assuming that `k` is a `field`.

## Tags

submodule, subspace, linear map
-/

/-- A submodule of a module is one which is closed under vector operations.
  This is a sufficient condition for the subset of vectors in the submodule
  to themselves form a module. -/
structure submodule (R : Type u) (M : Type v) [semiring R] [add_comm_monoid M] [semimodule R M]
extends add_submonoid M, sub_mul_action R M
where

/-- Reinterpret a `submodule` as an `add_submonoid`. -/
/-- Reinterpret a `submodule` as an `sub_mul_action`. -/
namespace submodule

protected instance set.has_coe_t {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] [semimodule R M] : has_coe_t (submodule R M) (set M) :=
  has_coe_t.mk fun (s : submodule R M) => carrier s

protected instance has_mem {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] [semimodule R M] : has_mem M (submodule R M) :=
  has_mem.mk fun (x : M) (p : submodule R M) => x ∈ ↑p

protected instance has_coe_to_sort {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] [semimodule R M] : has_coe_to_sort (submodule R M) :=
  has_coe_to_sort.mk (Type (max 0 v)) fun (p : submodule R M) => Subtype fun (x : M) => x ∈ p

@[simp] theorem coe_sort_coe {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] [semimodule R M] (p : submodule R M) : ↥↑p = ↥p :=
  rfl

protected theorem exists {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] [semimodule R M] {p : submodule R M} {q : ↥p → Prop} : (∃ (x : ↥p), q x) ↔ ∃ (x : M), ∃ (H : x ∈ p), q { val := x, property := H } :=
  set_coe.exists

protected theorem forall {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] [semimodule R M] {p : submodule R M} {q : ↥p → Prop} : (∀ (x : ↥p), q x) ↔ ∀ (x : M) (H : x ∈ p), q { val := x, property := H } :=
  set_coe.forall

theorem coe_injective {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] [semimodule R M] : function.injective coe := sorry

@[simp] theorem coe_set_eq {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] [semimodule R M] {p : submodule R M} {q : submodule R M} : ↑p = ↑q ↔ p = q :=
  function.injective.eq_iff coe_injective

@[simp] theorem mk_coe {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] [semimodule R M] (S : set M) (h₁ : 0 ∈ S) (h₂ : ∀ {a b : M}, a ∈ S → b ∈ S → a + b ∈ S) (h₃ : ∀ (c : R) {x : M}, x ∈ S → c • x ∈ S) : ↑(mk S h₁ h₂ h₃) = S :=
  rfl

theorem ext'_iff {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] [semimodule R M] {p : submodule R M} {q : submodule R M} : p = q ↔ ↑p = ↑q :=
  iff.symm coe_set_eq

theorem ext {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] [semimodule R M] {p : submodule R M} {q : submodule R M} (h : ∀ (x : M), x ∈ p ↔ x ∈ q) : p = q :=
  coe_injective (set.ext h)

theorem to_add_submonoid_injective {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] [semimodule R M] : function.injective to_add_submonoid :=
  fun (p q : submodule R M) (h : to_add_submonoid p = to_add_submonoid q) =>
    iff.mpr ext'_iff (iff.mp add_submonoid.ext'_iff h)

@[simp] theorem to_add_submonoid_eq {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] [semimodule R M] {p : submodule R M} {q : submodule R M} : to_add_submonoid p = to_add_submonoid q ↔ p = q :=
  function.injective.eq_iff to_add_submonoid_injective

theorem to_sub_mul_action_injective {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] [semimodule R M] : function.injective to_sub_mul_action :=
  fun (p q : submodule R M) (h : to_sub_mul_action p = to_sub_mul_action q) =>
    iff.mpr ext'_iff (iff.mp sub_mul_action.ext'_iff h)

@[simp] theorem to_sub_mul_action_eq {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] [semimodule R M] {p : submodule R M} {q : submodule R M} : to_sub_mul_action p = to_sub_mul_action q ↔ p = q :=
  function.injective.eq_iff to_sub_mul_action_injective

end submodule

namespace submodule

-- We can infer the module structure implicitly from the bundled submodule,

-- rather than via typeclass resolution.

@[simp] theorem mem_carrier {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] {semimodule_M : semimodule R M} (p : submodule R M) {x : M} : x ∈ carrier p ↔ x ∈ ↑p :=
  iff.rfl

@[simp] theorem mem_coe {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] {semimodule_M : semimodule R M} (p : submodule R M) {x : M} : x ∈ ↑p ↔ x ∈ p :=
  iff.rfl

@[simp] theorem zero_mem {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] {semimodule_M : semimodule R M} (p : submodule R M) : 0 ∈ p :=
  zero_mem' p

theorem add_mem {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] {semimodule_M : semimodule R M} (p : submodule R M) {x : M} {y : M} (h₁ : x ∈ p) (h₂ : y ∈ p) : x + y ∈ p :=
  add_mem' p h₁ h₂

theorem smul_mem {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] {semimodule_M : semimodule R M} (p : submodule R M) {x : M} (r : R) (h : x ∈ p) : r • x ∈ p :=
  smul_mem' p r h

theorem sum_mem {R : Type u} {M : Type v} {ι : Type w} [semiring R] [add_comm_monoid M] {semimodule_M : semimodule R M} (p : submodule R M) {t : finset ι} {f : ι → M} : (∀ (c : ι), c ∈ t → f c ∈ p) → (finset.sum t fun (i : ι) => f i) ∈ p :=
  add_submonoid.sum_mem (to_add_submonoid p)

theorem sum_smul_mem {R : Type u} {M : Type v} {ι : Type w} [semiring R] [add_comm_monoid M] {semimodule_M : semimodule R M} (p : submodule R M) {t : finset ι} {f : ι → M} (r : ι → R) (hyp : ∀ (c : ι), c ∈ t → f c ∈ p) : (finset.sum t fun (i : ι) => r i • f i) ∈ p :=
  sum_mem p fun (i : ι) (hi : i ∈ t) => smul_mem p (r i) (hyp i hi)

@[simp] theorem smul_mem_iff' {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] {semimodule_M : semimodule R M} (p : submodule R M) {x : M} (u : units R) : ↑u • x ∈ p ↔ x ∈ p :=
  sub_mul_action.smul_mem_iff' (to_sub_mul_action p) u

protected instance has_add {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] {semimodule_M : semimodule R M} (p : submodule R M) : Add ↥p :=
  { add := fun (x y : ↥p) => { val := subtype.val x + subtype.val y, property := sorry } }

protected instance has_zero {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] {semimodule_M : semimodule R M} (p : submodule R M) : HasZero ↥p :=
  { zero := { val := 0, property := zero_mem p } }

protected instance inhabited {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] {semimodule_M : semimodule R M} (p : submodule R M) : Inhabited ↥p :=
  { default := 0 }

protected instance has_scalar {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] {semimodule_M : semimodule R M} (p : submodule R M) : has_scalar R ↥p :=
  has_scalar.mk fun (c : R) (x : ↥p) => { val := c • subtype.val x, property := sorry }

protected theorem nonempty {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] {semimodule_M : semimodule R M} (p : submodule R M) : set.nonempty ↑p :=
  Exists.intro 0 (zero_mem p)

@[simp] theorem mk_eq_zero {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] {semimodule_M : semimodule R M} (p : submodule R M) {x : M} (h : x ∈ p) : { val := x, property := h } = 0 ↔ x = 0 :=
  subtype.ext_iff_val

@[simp] theorem coe_eq_coe {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] {semimodule_M : semimodule R M} {p : submodule R M} {x : ↥p} {y : ↥p} : ↑x = ↑y ↔ x = y :=
  iff.symm subtype.ext_iff_val

@[simp] theorem coe_eq_zero {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] {semimodule_M : semimodule R M} {p : submodule R M} {x : ↥p} : ↑x = 0 ↔ x = 0 :=
  coe_eq_coe

@[simp] theorem coe_add {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] {semimodule_M : semimodule R M} {p : submodule R M} (x : ↥p) (y : ↥p) : ↑(x + y) = ↑x + ↑y :=
  rfl

@[simp] theorem coe_zero {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] {semimodule_M : semimodule R M} {p : submodule R M} : ↑0 = 0 :=
  rfl

@[simp] theorem coe_smul {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] {semimodule_M : semimodule R M} {p : submodule R M} (r : R) (x : ↥p) : ↑(r • x) = r • ↑x :=
  rfl

@[simp] theorem coe_mk {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] {semimodule_M : semimodule R M} {p : submodule R M} (x : M) (hx : x ∈ p) : ↑{ val := x, property := hx } = x :=
  rfl

@[simp] theorem coe_mem {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] {semimodule_M : semimodule R M} {p : submodule R M} (x : ↥p) : ↑x ∈ p :=
  subtype.property x

@[simp] protected theorem eta {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] {semimodule_M : semimodule R M} {p : submodule R M} (x : ↥p) (hx : ↑x ∈ p) : { val := ↑x, property := hx } = x :=
  subtype.eta x hx

protected instance add_comm_monoid {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] {semimodule_M : semimodule R M} (p : submodule R M) : add_comm_monoid ↥p :=
  add_comm_monoid.mk Add.add sorry 0 sorry sorry sorry

protected instance semimodule {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] {semimodule_M : semimodule R M} (p : submodule R M) : semimodule R ↥p :=
  semimodule.mk sorry sorry

/-- Embedding of a submodule `p` to the ambient space `M`. -/
protected def subtype {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] {semimodule_M : semimodule R M} (p : submodule R M) : linear_map R (↥p) M :=
  linear_map.mk coe sorry sorry

@[simp] theorem subtype_apply {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] {semimodule_M : semimodule R M} (p : submodule R M) (x : ↥p) : coe_fn (submodule.subtype p) x = ↑x :=
  rfl

theorem subtype_eq_val {R : Type u} {M : Type v} [semiring R] [add_comm_monoid M] {semimodule_M : semimodule R M} (p : submodule R M) : ⇑(submodule.subtype p) = subtype.val :=
  rfl

theorem neg_mem {R : Type u} {M : Type v} [ring R] [add_comm_group M] {semimodule_M : semimodule R M} (p : submodule R M) {x : M} (hx : x ∈ p) : -x ∈ p :=
  sub_mul_action.neg_mem (to_sub_mul_action p) hx

/-- Reinterpret a submodule as an additive subgroup. -/
def to_add_subgroup {R : Type u} {M : Type v} [ring R] [add_comm_group M] {semimodule_M : semimodule R M} (p : submodule R M) : add_subgroup M :=
  add_subgroup.mk (add_submonoid.carrier (to_add_submonoid p)) sorry sorry sorry

@[simp] theorem coe_to_add_subgroup {R : Type u} {M : Type v} [ring R] [add_comm_group M] {semimodule_M : semimodule R M} (p : submodule R M) : ↑(to_add_subgroup p) = ↑p :=
  rfl

theorem sub_mem {R : Type u} {M : Type v} [ring R] [add_comm_group M] {semimodule_M : semimodule R M} (p : submodule R M) {x : M} {y : M} : x ∈ p → y ∈ p → x - y ∈ p :=
  add_subgroup.sub_mem (to_add_subgroup p)

@[simp] theorem neg_mem_iff {R : Type u} {M : Type v} [ring R] [add_comm_group M] {semimodule_M : semimodule R M} (p : submodule R M) {x : M} : -x ∈ p ↔ x ∈ p :=
  add_subgroup.neg_mem_iff (to_add_subgroup p)

theorem add_mem_iff_left {R : Type u} {M : Type v} [ring R] [add_comm_group M] {semimodule_M : semimodule R M} (p : submodule R M) {x : M} {y : M} : y ∈ p → (x + y ∈ p ↔ x ∈ p) :=
  add_subgroup.add_mem_cancel_right (to_add_subgroup p)

theorem add_mem_iff_right {R : Type u} {M : Type v} [ring R] [add_comm_group M] {semimodule_M : semimodule R M} (p : submodule R M) {x : M} {y : M} : x ∈ p → (x + y ∈ p ↔ y ∈ p) :=
  add_subgroup.add_mem_cancel_left (to_add_subgroup p)

protected instance has_neg {R : Type u} {M : Type v} [ring R] [add_comm_group M] {semimodule_M : semimodule R M} (p : submodule R M) : Neg ↥p :=
  { neg := fun (x : ↥p) => { val := -subtype.val x, property := sorry } }

@[simp] theorem coe_neg {R : Type u} {M : Type v} [ring R] [add_comm_group M] {semimodule_M : semimodule R M} (p : submodule R M) (x : ↥p) : ↑(-x) = -↑x :=
  rfl

protected instance add_comm_group {R : Type u} {M : Type v} [ring R] [add_comm_group M] {semimodule_M : semimodule R M} (p : submodule R M) : add_comm_group ↥p :=
  add_comm_group.mk Add.add sorry 0 sorry sorry Neg.neg add_comm_group.sub sorry sorry

@[simp] theorem coe_sub {R : Type u} {M : Type v} [ring R] [add_comm_group M] {semimodule_M : semimodule R M} (p : submodule R M) (x : ↥p) (y : ↥p) : ↑(x - y) = ↑x - ↑y :=
  rfl

end submodule

namespace submodule

theorem smul_mem_iff {R : Type u} {M : Type v} [division_ring R] [add_comm_group M] [module R M] (p : submodule R M) {r : R} {x : M} (r0 : r ≠ 0) : r • x ∈ p ↔ x ∈ p :=
  sub_mul_action.smul_mem_iff (to_sub_mul_action p) r0

end submodule

/-- Subspace of a vector space. Defined to equal `submodule`. -/
def subspace (R : Type u) (M : Type v) [field R] [add_comm_group M] [vector_space R M] :=
  submodule R M


-- Una_funcion_tiene_inversa_por_la_izquierda_si_y_solo_si_es_inyectiva.lean
-- Una función tiene inversa por la izquierda si y solo si es inyectiva
-- José A. Alonso Jiménez
-- Sevilla, 4 de agosto de 2021
-- ---------------------------------------------------------------------

-- ---------------------------------------------------------------------
-- En Lean, que g es una inversa por la izquierda de f está definido por
--    left_inverse (g : β → α) (f : α → β) : Prop :=
--       ∀ x, g (f x) = x
-- y que f tenga inversa por la izquierda está definido por
--    has_left_inverse (f : α → β) : Prop :=
--       ∃ finv : β → α, left_inverse finv f
-- Finalmente, que f es inyectiva está definido por
--    injective (f : α → β) : Prop :=
--       ∀ ⦃x y⦄, f x = f y → x = y
--
-- Demostrar que una función f, con dominio no vacío, tiene inversa por
-- la izquierda si y solo si es inyectiva.
-- ---------------------------------------------------------------------

import tactic
open function

variables {α : Type*} [nonempty α]
variable  {β : Type*}
variable  {f : α → β}

-- 1ª demostración
example : has_left_inverse f ↔ injective f :=
begin
  split,
  { intro hf,
    intros x y hxy,
    cases hf with g hg,
    calc x = g (f x) : (hg x).symm
       ... = g (f y) : congr_arg g hxy
       ... = y       : hg y, },
  { intro hf,
    use inv_fun f,
    intro x,
    apply hf,
    apply inv_fun_eq,
    use x, },
end

-- 2ª demostración
example : has_left_inverse f ↔ injective f :=
begin
  split,
  { intro hf,
    exact has_left_inverse.injective hf },
  { intro hf,
    exact injective.has_left_inverse hf },
end

-- 3ª demostración
example : has_left_inverse f ↔ injective f :=
⟨has_left_inverse.injective, injective.has_left_inverse⟩

-- 4ª demostración
example : has_left_inverse f ↔ injective f :=
injective_iff_has_left_inverse.symm


-- Demostracion_sin_logica_clasica.lean
-- Demostración sin lógica clasica.
-- José A. Alonso Jiménez <https://jaalonso.github.io>
-- Sevilla, 27-junio-2022
-- ---------------------------------------------------------------------

import tactic

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar, sin usar lógica clásica,
--    ¬(p ↔ ¬p)
-- ---------------------------------------------------------------------

variable p : Prop

-- 1ª demostración
example : ¬(p ↔ ¬p) :=
  ( assume hppf : p ↔ ¬p,
    have hppf1 : p → ¬p, from iff.elim_left hppf,
    have hppf2 : ¬p → p, from iff.elim_right hppf,
    have hpf : ¬p, from (assume hp : p, ((hppf1 hp) hp)),
    have hp : p, from (hppf2 hpf),
    (hppf1 hp) hp)

-- 2ª demostración
example : ¬(p ↔ ¬p) :=
begin
  by_contra h1,
  have hnp : ¬p ,
  { by_contra h2,
    have h3 : ¬ p := h1.mp h2,
    exact h3 h2, },
  apply hnp,
  exact h1.mpr hnp,
end


/-
Copyright (c) 2021 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import algebra.algebra.subalgebra.basic
import topology.algebra.module.basic
import topology.algebra.field

/-!
# Topological (sub)algebras

A topological algebra over a topological semiring `R` is a topological semiring with a compatible
continuous scalar multiplication by elements of `R`. We reuse typeclass `has_continuous_smul` for
topological algebras.

## Results

This is just a minimal stub for now!

The topological closure of a subalgebra is still a subalgebra,
which as an algebra is a topological algebra.
-/

open classical set topological_space algebra
open_locale classical

universes u v w

section topological_algebra
variables (R : Type*) [topological_space R] [comm_semiring R]
variables (A : Type u) [topological_space A]
variables [semiring A]

lemma continuous_algebra_map_iff_smul [algebra R A] [topological_semiring A] :
  continuous (algebra_map R A) ↔ continuous (λ p : R × A, p.1 • p.2) :=
begin
  refine ⟨λ h, _, λ h, _⟩,
  { simp only [algebra.smul_def], exact (h.comp continuous_fst).mul continuous_snd },
  { rw algebra_map_eq_smul_one', exact h.comp (continuous_id.prod_mk continuous_const) }
end

@[continuity]
lemma continuous_algebra_map [algebra R A] [topological_semiring A] [has_continuous_smul R A] :
  continuous (algebra_map R A) :=
(continuous_algebra_map_iff_smul R A).2 continuous_smul

lemma has_continuous_smul_of_algebra_map [algebra R A] [topological_semiring A]
  (h : continuous (algebra_map R A)) :
  has_continuous_smul R A :=
⟨(continuous_algebra_map_iff_smul R A).1 h⟩

end topological_algebra

section topological_algebra
variables {R : Type*} [comm_semiring R]
variables {A : Type u} [topological_space A]
variables [semiring A]
variables [algebra R A] [topological_semiring A]

/-- The closure of a subalgebra in a topological algebra as a subalgebra. -/
def subalgebra.topological_closure (s : subalgebra R A) : subalgebra R A :=
{ carrier := closure (s : set A),
  algebra_map_mem' := λ r, s.to_subsemiring.subring_topological_closure (s.algebra_map_mem r),
  .. s.to_subsemiring.topological_closure }

@[simp] lemma subalgebra.topological_closure_coe (s : subalgebra R A) :
  (s.topological_closure : set A) = closure (s : set A) :=
rfl

instance subalgebra.topological_closure_topological_semiring (s : subalgebra R A) :
  topological_semiring (s.topological_closure) :=
s.to_subsemiring.topological_closure_topological_semiring

instance subalgebra.topological_closure_topological_algebra
  [topological_space R] [has_continuous_smul R A] (s : subalgebra R A) :
  has_continuous_smul R (s.topological_closure) :=
s.to_submodule.topological_closure_has_continuous_smul

lemma subalgebra.subalgebra_topological_closure (s : subalgebra R A) :
  s ≤ s.topological_closure :=
subset_closure

lemma subalgebra.is_closed_topological_closure (s : subalgebra R A) :
  is_closed (s.topological_closure : set A) :=
by convert is_closed_closure

lemma subalgebra.topological_closure_minimal
  (s : subalgebra R A) {t : subalgebra R A} (h : s ≤ t) (ht : is_closed (t : set A)) :
  s.topological_closure ≤ t :=
closure_minimal h ht

/-- If a subalgebra of a topological algebra is commutative, then so is its topological closure. -/
def subalgebra.comm_semiring_topological_closure [t2_space A] (s : subalgebra R A)
  (hs : ∀ (x y : s), x * y = y * x) : comm_semiring s.topological_closure :=
{ ..s.topological_closure.to_semiring,
  ..s.to_submonoid.comm_monoid_topological_closure hs }

/--
This is really a statement about topological algebra isomorphisms,
but we don't have those, so we use the clunky approach of talking about
an algebra homomorphism, and a separate homeomorphism,
along with a witness that as functions they are the same.
-/
lemma subalgebra.topological_closure_comap'_homeomorph
  (s : subalgebra R A)
  {B : Type*} [topological_space B] [ring B] [topological_ring B] [algebra R B]
  (f : B →ₐ[R] A) (f' : B ≃ₜ A) (w : (f : B → A) = f') :
  s.topological_closure.comap' f = (s.comap' f).topological_closure :=
begin
  apply set_like.ext',
  simp only [subalgebra.topological_closure_coe],
  simp only [subalgebra.coe_comap, subsemiring.coe_comap, alg_hom.coe_to_ring_hom],
  rw [w],
  exact f'.preimage_closure _,
end

end topological_algebra

section ring
variables {R : Type*} [comm_ring R]
variables {A : Type u} [topological_space A]
variables [ring A]
variables [algebra R A] [topological_ring A]

/-- If a subalgebra of a topological algebra is commutative, then so is its topological closure.
See note [reducible non-instances]. -/
@[reducible] def subalgebra.comm_ring_topological_closure [t2_space A] (s : subalgebra R A)
  (hs : ∀ (x y : s), x * y = y * x) : comm_ring s.topological_closure :=
{ ..s.topological_closure.to_ring,
  ..s.to_submonoid.comm_monoid_topological_closure hs }

variables (R)
/-- The topological closure of the subalgebra generated by a single element. -/
def algebra.elemental_algebra (x : A) : subalgebra R A :=
(algebra.adjoin R ({x} : set A)).topological_closure

lemma algebra.self_mem_elemental_algebra (x : A) : x ∈ algebra.elemental_algebra R x :=
set_like.le_def.mp (subalgebra.subalgebra_topological_closure (algebra.adjoin R ({x} : set A))) $
  algebra.self_mem_adjoin_singleton R x

variables {R}

instance [t2_space A] {x : A} : comm_ring (algebra.elemental_algebra R x) :=
subalgebra.comm_ring_topological_closure _
begin
  letI : comm_ring (algebra.adjoin R ({x} : set A)) := algebra.adjoin_comm_ring_of_comm R
    (λ y hy z hz, by {rw [mem_singleton_iff] at hy hz, rw [hy, hz]}),
  exact λ _ _, mul_comm _ _,
end

end ring

section division_ring

/-- The action induced by `algebra_rat` is continuous. -/
instance division_ring.has_continuous_const_smul_rat
  {A} [division_ring A] [topological_space A] [has_continuous_mul A] [char_zero A] :
  has_continuous_const_smul ℚ A :=
⟨λ r, continuous_const.mul continuous_id⟩

end division_ring


/-== Chapter 3: Propositions and proofs ==-/

/- Working with propositions as types -/
namespace working_with_props

variable {p q : Prop}

theorem t1 : p → q → p := λ hp hq => hp

#print t1

namespace using_show

  theorem t1 : p → q → p :=
    λ hp : p =>
    λ hq : q =>
    show p from hp

end using_show

namespace as_function

  theorem t1 (hp : p) (hq : q) : p := hp

  #print t1

  axiom hp : p

  theorem t2 : q → p := t1 hp

end as_function

namespace axiom_unsafe

  axiom unsound : False
  -- Everything follows from false
  theorem ex : 1 = 0 :=
    False.elim unsound

end axiom_unsafe

namespace max_args

  theorem t1 {p q : Prop} (hp : p) (hq : q) : p := hp
  #print t1

end max_args

namespace min_args

  theorem t1 : ∀ {p q : Prop}, p → q → p :=
    fun {p q : Prop} (hp : p) (hq : q) => hp

  #print t1

end min_args

namespace prop_vars

  variable {p q : Prop}
  theorem t1 : p → q → p := fun (hp : p) (hq : q) => hp
  #print t1

end prop_vars

namespace more_prop_vars

  variable {p q : Prop}
  variable (hp : p)

  theorem t1 : q → p := fun (hq : q) => hp
  #print t1

end more_prop_vars

namespace apply_theorem

  theorem t1 (p q : Prop) (hp : p) (hq : q) : p := hp

  variable (p q r s : Prop)

  #check t1 p q
  #check t1 r s
  #check t1 (r → s) (s → r)

  variable (h : r → s)
  #check t1 (r → s) (s → r) h

end apply_theorem

variable (p q r s : Prop)

-- Implication is transitive / function composition
theorem t2 (h₁ : q → r) (h₂ : p → q) : p → r :=
  fun h₃ : p =>
  show r from h₁ (h₂ h₃)

end working_with_props

/- Propositional logic -/
namespace propositional_logic

variable (p q : Prop)

#check p → q → p ∧ q
#check ¬p → p ↔ False
#check p ∨ q → q ∨ p

-- Conjunction
example (hp : p) (hq : q) : p ∧ q := And.intro hp hq
#check fun (hp : p) (hq : q) => And.intro hp hq

example (h : p ∧ q) : p := And.left h
example (h : p ∧ q) : q := And.right h

example (h : p ∧ q) : q ∧ p :=
  And.intro (And.right h) (And.left h)

#check λ (hp : p) (hq : q) => (⟨hp, hq⟩ : p ∧ q)

variable (xs : List Nat)

#check List.length xs
#check xs.length

example (h : p ∧ q) : q ∧ p := ⟨h.right, h.left⟩

example (h : p ∧ q) : q ∧ p ∧ q :=
  ⟨h.right, ⟨h.left, h.right⟩⟩

example (h : p ∧ q) : q ∧ p ∧ q :=
  ⟨h.right, h.left, h.right⟩

-- Disjunction
example (hp : p) : p ∨ q := Or.intro_left q hp
example (hq : q) : p ∨ q := Or.intro_right p hq

variable (r : Prop)

example (h : p ∨ q) : q ∨ p :=
  Or.elim h
    (fun hp : p =>
      show q ∨ p from Or.intro_right q hp)
    (fun hq : q =>
      show q ∨ p from Or.intro_left p hq)

example (h : p ∨ q) : q ∨ p :=
  Or.elim h (fun hp => Or.inr hp) (fun hq => Or.inl hq)

example (h : p ∨ q) : q ∨ p :=
  h.elim (fun hp => Or.inr hp) (fun hq => Or.inl hq)

example (h : p ∨ q) : q ∨ p := h.elim Or.inr Or.inl

-- Negation and falsity
example (hpq : p → q) (hnq : ¬q) : ¬p :=
  fun hp : p =>
  show False from hnq (hpq hp)

example (hp : p) (hnp : ¬p) : q := False.elim (hnp hp)

example (hp : p) (hnp : ¬p) : q := absurd hp hnp

example (hnp : ¬p) (hq : q) (hqp : q → p) : r :=
  absurd (hqp hq) hnp

-- Logical equivalence
theorem and_swap : p ∧ q ↔ q ∧ p :=
  Iff.intro
    (fun h : p ∧ q =>
      show q ∧ p from And.intro (And.right h) (And.left h))
    (fun h : q ∧ p =>
      show p ∧ q from And.intro (And.right h) (And.left h))

#check and_swap p q

example (h : p ∧ q) : q ∧ p := Iff.mp (and_swap p q) h

namespace concise

  theorem and_swap : p ∧ q ↔ q ∧ p :=
    ⟨λ h => ⟨h.right, h.left⟩, λ h => ⟨h.right, h.left⟩⟩

  example (h : p ∧ q) : q ∧ p := (and_swap p q).mp h

end concise

end propositional_logic

/- Introducing auxiliary subgoals -/
namespace auxiliary

variable (p q : Prop)

example (h : p ∧ q) : q ∧ p :=
  have hp : p := h.left
  have hq : q := h.right
  show q ∧ p from And.intro hq hp

example (h : p ∧ q) : q ∧ p :=
  have hp : p := h.left
  suffices hq : q from And.intro hq hp
  show q from And.right h

end auxiliary

/- Classical logic -/
namespace classical_logic

open Classical

variable (p : Prop)
#check em p

theorem dne {p : Prop} (h : ¬¬p) : p :=
  (em p).elim
    (λ hp : p => hp)
    (λ hnp : ¬p => absurd hnp h)

example {p : Prop} (h : {q : Prop} → ¬¬q → q) : p ∨ ¬p :=
  suffices em_irrefutable : ¬¬(p ∨ ¬p) from h em_irrefutable
  show ¬¬(p ∨ ¬p) from λ em_refutable : ¬(p ∨ ¬p) =>
    suffices em₁ : p ∨ ¬p from absurd em₁ em_refutable
    show p ∨ ¬p from Or.inr λ hp : p =>
      suffices em₂ : p ∨ ¬p from absurd em₂ em_refutable
      show p ∨ ¬p from Or.inl hp

example (h : ¬¬p) : p :=
  byCases
    (λ hp : p => hp)
    (λ hnp : ¬p => absurd hnp h)

example (h : ¬¬p) : p :=
  byContradiction (λ hnp : ¬p => show False from h hnp)

example (h : ¬(p ∧ q)) : ¬p ∨ ¬q :=
  (em p).elim
    (λ hp : p =>
      suffices hnq : ¬q from Or.inr hnq
      show ¬q from λ hq : q =>
        have hpq : p ∧ q := ⟨hp, hq⟩
        show False from absurd hpq h)
    (λ hnp : ¬p => Or.inl hnp)

end classical_logic

/- Exercises -/
namespace exercises

variable (p q r s : Prop)

-- commutativity of ∧ and ∨
example : p ∧ q ↔ q ∧ p :=
  have swap : ∀ {x y : Prop}, x ∧ y → y ∧ x :=
    λ {x y : Prop} (hxy : x ∧ y) => ⟨hxy.right, hxy.left⟩
  ⟨swap, swap⟩

example : p ∨ q ↔ q ∨ p :=
  have swap : ∀ {x y : Prop}, x ∨ y → y ∨ x :=
    λ {x y : Prop} (hxy : x ∨ y) => hxy.elim Or.inr Or.inl
  ⟨swap, swap⟩

-- associativity of ∧ and ∨
example : (p ∧ q) ∧ r ↔ p ∧ (q ∧ r) :=
  have fwd : (p ∧ q) ∧ r → p ∧ (q ∧ r) :=
    λ h : (p ∧ q) ∧ r =>
      have hp : p := h.left.left
      have hq : q := h.left.right
      have hr : r := h.right
      show p ∧ (q ∧ r) from ⟨hp, ⟨hq, hr⟩⟩
  have rev : p ∧ (q ∧ r) → (p ∧ q) ∧ r :=
    λ h : p ∧ (q ∧ r) =>
      have hp : p := h.left
      have hq : q := h.right.left
      have hr : r := h.right.right
      show (p ∧ q) ∧ r from ⟨⟨hp, hq⟩, hr⟩
  show (p ∧ q) ∧ r ↔ p ∧ (q ∧ r) from ⟨fwd, rev⟩

example : (p ∨ q) ∨ r ↔ p ∨ (q ∨ r) :=
  have fwd : (p ∨ q) ∨ r → p ∨ (q ∨ r) :=
    λ hpqr : (p ∨ q) ∨ r => show p ∨ (q ∨ r) from hpqr.elim
      (λ hpq : p ∨ q => show p ∨ (q ∨ r) from hpq.elim
        (λ hp : p => Or.inl hp)
        (λ hq : q => Or.inr (Or.inl hq)))
      (λ hr : r => show p ∨ (q ∨ r) from Or.inr (Or.inr hr))
  have rev : p ∨ (q ∨ r) → (p ∨ q) ∨ r :=
    λ hpqr : p ∨ (q ∨ r) => show (p ∨ q) ∨ r from hpqr.elim
      (λ hp : p => show (p ∨ q) ∨ r from Or.inl (Or.inl hp))
      (λ hqr : q ∨ r => show (p ∨ q) ∨ r from hqr.elim
        (λ hq : q => Or.inl (Or.inr hq))
        (λ hr : r => Or.inr hr))
  show (p ∨ q) ∨ r ↔ p ∨ (q ∨ r) from ⟨fwd, rev⟩

-- distributivity
example : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) :=
  have fwd : p ∧ (q ∨ r) → (p ∧ q) ∨ (p ∧ r) := λ hpqr =>
    have hp : p := hpqr.left
    have hqr : q ∨ r := hpqr.right
    show (p ∧ q) ∨ (p ∧ r) from hqr.elim
      (λ hq => Or.inl ⟨hp, hq⟩)
      (λ hr => Or.inr ⟨hp, hr⟩)
  have rev : (p ∧ q) ∨ (p ∧ r) → p ∧ (q ∨ r) := λ hpqpr =>
    show p ∧ (q ∨ r) from hpqpr.elim
      (λ hpq => ⟨hpq.left, Or.inl hpq.right⟩)
      (λ hpr => ⟨hpr.left, Or.inr hpr.right⟩)
  show p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) from ⟨fwd, rev⟩

example : p ∨ (q ∧ r) ↔ (p ∨ q) ∧ (p ∨ r) :=
  have fwd : p ∨ (q ∧ r) → (p ∨ q) ∧ (p ∨ r) := λ hpqr =>
    show (p ∨ q) ∧ (p ∨ r) from hpqr.elim
      (λ hp => ⟨Or.inl hp, Or.inl hp⟩)
      (λ hqr => ⟨Or.inr hqr.left, Or.inr hqr.right⟩)
  have rev : (p ∨ q) ∧ (p ∨ r) → p ∨ (q ∧ r) := λ hpqpr =>
    have hpq : p ∨ q := hpqpr.left
    have hpr : p ∨ r := hpqpr.right
    show p ∨ (q ∧ r) from hpq.elim
      (λ hp => Or.inl hp)
      (λ hq => show p ∨ (q ∧ r) from hpr.elim
        (λ hp => Or.inl hp)
        (λ hr => Or.inr ⟨hq, hr⟩))
  show p ∨ (q ∧ r) ↔ (p ∨ q) ∧ (p ∨ r) from ⟨fwd, rev⟩

-- other properties
example : (p → (q → r)) ↔ (p ∧ q → r) :=
  have fwd : (p → (q → r)) → (p ∧ q → r) :=
    λ (hpqr : p → (q → r)) (hpq : p ∧ q) =>
      show r from hpqr hpq.left hpq.right
  have rev : (p ∧ q → r) → (p → (q → r)) :=
    λ (hpqr : p ∧ q → r) (hp : p) (hq : q) =>
      show r from hpqr ⟨hp, hq⟩
  show (p → (q → r)) ↔ (p ∧ q → r) from ⟨fwd, rev⟩

example : ((p ∨ q) → r) ↔ (p → r) ∧ (q → r) :=
  have fwd : ((p ∨ q) → r) → (p → r) ∧ (q → r) := λ hpqr =>
    have gpr : p → r := λ hp => hpqr (Or.inl hp)
    have gqr : q → r := λ hq => hpqr (Or.inr hq)
    show (p → r) ∧ (q → r) from ⟨gpr, gqr⟩
  have rev : (p → r) ∧ (q → r) → ((p ∨ q) → r) :=
    λ (hprqr : (p → r) ∧ (q → r)) (hpq : p ∨ q) =>
      have hpr : p → r := hprqr.left
      have hqr : q → r := hprqr.right
      show r from hpq.elim hpr hqr
  show ((p ∨ q) → r) ↔ (p → r) ∧ (q → r) from ⟨fwd, rev⟩

example : ¬(p ∨ q) ↔ ¬p ∧ ¬q :=
  have fwd : ¬(p ∨ q) → ¬p ∧ ¬q := λ hnpq =>
    have gnp : ¬p := λ hp => hnpq (Or.inl hp)
    have gnq : ¬q := λ hq => hnpq (Or.inr hq)
    show ¬p ∧ ¬q from ⟨gnp, gnq⟩
  have rev : ¬p ∧ ¬q → ¬(p ∨ q) :=
    λ (hnpnq : ¬p ∧ ¬q) (hpq : p ∨ q) =>
      have hnp : ¬p := hnpnq.left
      have hnq : ¬q := hnpnq.right
      show False from hpq.elim
        (λ hp : p => absurd hp hnp)
        (λ hq : q => absurd hq hnq)
  show ¬(p ∨ q) ↔ ¬p ∧ ¬q from ⟨fwd, rev⟩

example : ¬p ∨ ¬q → ¬(p ∧ q) :=
  λ (hnpnq : ¬p ∨ ¬q) (hpq : p ∧ q) =>
    have hp : p := hpq.left
    have hq : q := hpq.right
    show False from hnpnq.elim
      (λ hnp : ¬p => absurd hp hnp)
      (λ hnq : ¬q => absurd hq hnq)

example : ¬(p ∧ ¬p) := λ hpnp =>
  have hp : p := hpnp.left
  have hnp : ¬p := hpnp.right
  show False from absurd hp hnp

example : p ∧ ¬q → ¬(p → q) :=
  λ (hpnq : p ∧ ¬q) (hpq : p → q) =>
    have hp : p := hpnq.left
    have hq : q := hpq hp
    have hnq : ¬q := hpnq.right
    show False from absurd hq hnq

example : ¬p → (p → q) :=
  λ (hnp : ¬p) (hp : p) =>
    show q from absurd hp hnp

example : (¬p ∨ q) → (p → q) :=
  λ (hnpq : ¬p ∨ q) (hp : p) =>
    show q from hnpq.elim
      (λ hnp : ¬p => absurd hp hnp)
      (λ hq : q => hq)

example : p ∨ False ↔ p :=
  have fwd : p ∨ False → p := λ hpf =>
    show p from hpf.elim
      (λ hp : p => hp)
      (λ hf : False => hf.elim)
  have rev : p → p ∨ False :=
    Or.inl
  show p ∨ False ↔ p from ⟨fwd, rev⟩

example : p ∧ False ↔ False :=
  have fwd : p ∧ False → False := And.right
  have rev : False → p ∧ False := False.elim
  show p ∧ False ↔ False from ⟨fwd, rev⟩

example : (p → q) → (¬q → ¬p) :=
  λ (hpq : p → q) (hnq : ¬q) (hp : p) =>
    have hq : q := hpq hp
    show False from hnq hq

example : ¬(p ↔ ¬p) := λ p_iff_np =>
  have hpnp : p → ¬p := p_iff_np.mp
  have hnpp : ¬p → p := p_iff_np.mpr
  have hnp : ¬p := λ hp => hpnp hp hp
  have hnnp : ¬¬p := λ hnp => hnp (hnpp hnp)
  show False from hnnp hnp

open Classical

def contrapositive_rev {p q : Prop} (hnqnp : ¬q → ¬p) (hp : p) : q :=
  (em q).elim
    (λ hq : q => hq)
    (λ hnq : ¬q => absurd hp (hnqnp hnq))

example : (p → r ∨ s) → ((p → r) ∨ (p → s)) := λ hprs =>
  show (p → r) ∨ (p → s) from (em r).elim
    (λ hr : r =>
      have gpr : p → r := λ _ => hr
      show (p → r) ∨ (p → s) from Or.inl gpr)
    (λ hnr : ¬r =>
      have gps : p → s := λ hp =>
        (hprs hp).elim
          (λ hr : r => show s from absurd hr hnr)
          (λ hs : s => show s from hs)
      show (p → r) ∨ (p → s) from Or.inr gps)

example : ¬(p ∧ q) → ¬p ∨ ¬q := λ hnpq =>
  show ¬p ∨ ¬q from (em p).elim
    (λ hp : p => show ¬p ∨ ¬q from (em q).elim
      (λ hq : q => absurd ⟨hp, hq⟩ hnpq)
      (λ hnq : ¬q => Or.inr hnq))
    (λ hnp : ¬p => Or.inl hnp)

example : ¬(p → q) → p ∧ ¬q := λ hnpq =>
  (em q).elim
    (λ hq : q => absurd (λ hp : p => hq) hnpq)
    (λ hnq : ¬q => (em p).elim
      (λ hp : p => ⟨hp, hnq⟩)
      (λ hnp : ¬p =>
        have hpq : p → q := contrapositive_rev (λ hnq : ¬q => hnp)
        show p ∧ ¬q from absurd hpq hnpq))

example : (p → q) → (¬p ∨ q) := λ hpq =>
  (em p).elim
    (λ hp : p => Or.inr (hpq hp))
    (λ hnp : ¬p => Or.inl hnp)

example : (¬q → ¬p) → (p → q) := contrapositive_rev

example : p ∨ ¬p := em p

example : (((p → q) → p) → p) := λ hpqp =>
  show p from (em p).elim
    (λ hp : p =>
      show p from hp)
    (λ hnp : ¬p =>
      have gpq : p → q := λ hp =>
        show q from absurd hp hnp
      show p from hpqp gpq)

end exercises


/-
Copyright (c) 2022 by the authors listed in the file AUTHORS and their
institutional affiliations. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joe Hendrix, Wojciech Nawrocki
-/

/-!
We define bitvectors. We choose the `Fin` representation over others for its relative efficiency
(Lean has special support for `Nat`), alignment with `UIntXY` types which are also represented
with `Fin`, and the fact that bitwise operations on `Fin` are already defined. Some other possible
representations are `List Bool`, `{ l : List Bool // l.length = w}`, `Fin w → Bool`.

We also define many bitvector operations from the
[`QF_BV` logic](https://smtlib.cs.uiowa.edu/logics-all.shtml#QF_BV).
of SMT-LIBv2.

TODO(WN): This is planned to go into mathlib4 once we:
  - have sorry-free bound proofs
  - match the interface to what SMT-LIB provides
  - are otherwise happy with the API
-/

/-- A bitvector of the specified width. This is represented as the underlying `Nat` number
in both the runtime and the kernel, inheriting all the special support for `Nat`. -/
def BitVec (w : Nat) := Fin (2^w)

instance : DecidableEq (BitVec w) :=
  inferInstanceAs (DecidableEq (Fin _))

namespace BitVec

theorem pow_two_gt_zero (w : Nat) : 2^w > 0 :=
  Nat.pos_pow_of_pos _ (by decide)

protected def zero (w : Nat) : BitVec w :=
  ⟨0, pow_two_gt_zero w⟩

/-- The bitvector `n mod 2^w`. -/
protected def ofNat (w : Nat) (n : Nat) : BitVec w :=
  Fin.ofNat' n (pow_two_gt_zero w)

instance : Inhabited (BitVec w) := ⟨BitVec.zero w⟩

instance : OfNat (BitVec w) (nat_lit 0) :=
  ⟨BitVec.zero w⟩

-- We inherit `Fin` implementations when fast but write mod/div
-- ourselves to avoid the extra modulo operation.
protected def add (x y : BitVec w) : BitVec w := Fin.add x y
protected def sub (x y : BitVec w) : BitVec w := Fin.sub x y
protected def mul (x y : BitVec w) : BitVec w := Fin.mul x y

protected def mod (x y : BitVec w) : BitVec w :=
  ⟨x.val % y.val, Nat.lt_of_le_of_lt (Nat.mod_le _ _) x.isLt⟩
protected def div (x y : BitVec w) : BitVec w :=
  ⟨x.val / y.val, Nat.lt_of_le_of_lt (Nat.div_le_self _ _) x.isLt⟩

protected def lt (x y : BitVec w) : Bool :=
  x.val < y.val
protected def le (x y : BitVec w) : Bool :=
  x.val ≤ y.val

instance : Add (BitVec w) := ⟨BitVec.add⟩
instance : Sub (BitVec w) := ⟨BitVec.sub⟩
instance : Mul (BitVec w) := ⟨BitVec.mul⟩
instance : Mod (BitVec w) := ⟨BitVec.mod⟩
instance : Div (BitVec w) := ⟨BitVec.div⟩
instance : LT (BitVec w)  := ⟨fun x y => BitVec.lt x y⟩
instance : LE (BitVec w)  := ⟨fun x y => BitVec.le x y⟩

protected def complement (x : BitVec w) : BitVec w :=
  0 - (x + .ofNat w 1)

protected def and (x y : BitVec w) : BitVec w :=
  ⟨x.val &&& y.val, sorry⟩

protected def or (x y : BitVec w) : BitVec w :=
  ⟨x.val ||| y.val, sorry⟩

protected def xor (x y : BitVec w) : BitVec w :=
  ⟨x.val ^^^ y.val, sorry⟩

protected def shiftLeft (x : BitVec w) (n : Nat) : BitVec w :=
  .ofNat w (x.val <<< n)

protected def shiftRight (x : BitVec w) (n : Nat) : BitVec w :=
  ⟨x.val >>> n, sorry⟩

instance : Complement (BitVec w) := ⟨BitVec.complement⟩
instance : AndOp (BitVec w) := ⟨BitVec.and⟩
instance : OrOp (BitVec w) := ⟨BitVec.or⟩
instance : Xor (BitVec w) := ⟨BitVec.xor⟩
instance : HShiftLeft (BitVec w) Nat (BitVec w) := ⟨BitVec.shiftLeft⟩
instance : HShiftRight (BitVec w) Nat (BitVec w) := ⟨BitVec.shiftRight⟩

def rotateLeft (x : BitVec w) (n : Nat) : BitVec w :=
  x <<< n ||| x >>> (w - n)

def rotateRight (x : BitVec w) (n : Nat) : BitVec w :=
  x >>> n ||| x <<< (w - n)

protected def append (x : BitVec w) (y : BitVec v) : BitVec (w+v) :=
  ⟨x.val <<< v ||| y.val, sorry⟩

instance : HAppend (BitVec w) (BitVec v) (BitVec (w+v)) := ⟨BitVec.append⟩

def extract (i j : Nat) (x : BitVec w) : BitVec (i - j + 1) :=
  BitVec.ofNat _ (x.val >>> j)

def repeat_ : (i : Nat) → BitVec w → BitVec (w*i)
  | 0,   _ => 0
  | n+1, x =>
    have hEq : w + w*n = w*(n + 1) := by
      rw [Nat.mul_add, Nat.add_comm, Nat.mul_one]
    hEq ▸ (x ++ repeat_ n x)

def zeroExtend (i : Nat) (x : BitVec w) : BitVec (w+i) :=
  have hEq : w+i = i+w := Nat.add_comm _ _
  hEq ▸ ((0 : BitVec i) ++ x)

def signExtend (i : Nat) (x : BitVec w) : BitVec (w+i) :=
  have hEq : ((w-1) - (w-1) + 1)*i + w = w+i := by
    rw [Nat.sub_self, Nat.zero_add, Nat.one_mul, Nat.add_comm]
  hEq ▸ ((repeat_ i (extract (w-1) (w-1) x)) ++ x)

-- `prefix` may be a better name
def shrink (v : Nat) (x : BitVec w) : BitVec v :=
  if hZero : 0 < v then
    have hEq : v - 1 + 0 + 1 = v := by
      rw [Nat.add_zero]
      exact Nat.sub_add_cancel hZero
    hEq ▸ x.extract (v - 1) 0
  else 0

/-- Return the `i`-th least significant bit. -/
def lsbGet (x : BitVec w) (i : Nat) : Bool :=
  x.extract i i != 0

end BitVec