/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Mario Carneiro, Kevin Buzzard, Yury Kudryashov

! This file was ported from Lean 3 source module linear_algebra.quotient
! leanprover-community/mathlib commit 48085f140e684306f9e7da907cd5932056d1aded
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.GroupTheory.QuotientGroup
import Mathlib.LinearAlgebra.Span

/-!
# Quotients by submodules

* If `p` is a submodule of `M`, `M ⧸ p` is the quotient of `M` with respect to `p`:
  that is, elements of `M` are identified if their difference is in `p`. This is itself a module.

-/

section deinstance_nonassocring
-- porting note: because we're missing lean4#2074 we need this, see:
-- https://leanprover.zulipchat.com/#narrow/stream/287929-mathlib4/topic/LinearAlgebra.2ESpan.20!4.232248
attribute [-instance] Ring.toNonAssocRing

-- For most of this file we work over a noncommutative ring
section Ring

namespace Submodule

variable {R M : Type _} {r : R} {x y : M} [Ring R] [AddCommGroup M] [Module R M]

variable (p p' : Submodule R M)

open LinearMap QuotientAddGroup

/-- The equivalence relation associated to a submodule `p`, defined by `x ≈ y` iff `-x + y ∈ p`.

Note this is equivalent to `y - x ∈ p`, but defined this way to be be defeq to the `add_subgroup`
version, where commutativity can't be assumed. -/
def quotientRel : Setoid M :=
  QuotientAddGroup.leftRel p.toAddSubgroup
#align submodule.quotient_rel Submodule.quotientRel

theorem quotientRel_r_def {x y : M} : @Setoid.r _ p.quotientRel x y ↔ x - y ∈ p :=
  Iff.trans
    (by
      rw [leftRel_apply, sub_eq_add_neg, neg_add, neg_neg]
      rfl)
    neg_mem_iff
#align submodule.quotient_rel_r_def Submodule.quotientRel_r_def

/-- The quotient of a module `M` by a submodule `p ⊆ M`. -/
instance hasQuotient : HasQuotient M (Submodule R M) :=
  ⟨fun p => Quotient (quotientRel p)⟩
#align submodule.has_quotient Submodule.hasQuotient

namespace Quotient

/-- Map associating to an element of `M` the corresponding element of `M/p`,
when `p` is a submodule of `M`. -/
def mk {p : Submodule R M} : M → M ⧸ p :=
  Quotient.mk''
#align submodule.quotient.mk Submodule.Quotient.mk

/- porting note: here and throughout elaboration is sped up *tremendously* (in some cases even
avoiding timeouts) by providing type ascriptions to `mk` (or `mk x`) and its variants. Lean 3
didn't need this help. -/
@[simp]
theorem mk'_eq_mk' {p : Submodule R M} (x : M) :
    @Quotient.mk' _ (quotientRel p) x = (mk : M → M ⧸ p) x :=
  rfl
#align submodule.quotient.mk_eq_mk Submodule.Quotient.mk'_eq_mk'

@[simp]
theorem mk''_eq_mk {p : Submodule R M} (x : M) : (Quotient.mk'' x : M ⧸ p) = (mk : M → M ⧸ p) x :=
  rfl
#align submodule.quotient.mk'_eq_mk Submodule.Quotient.mk''_eq_mk

@[simp]
theorem quot_mk_eq_mk {p : Submodule R M} (x : M) : (Quot.mk _ x : M ⧸ p) = (mk : M → M ⧸ p) x :=
  rfl
#align submodule.quotient.quot_mk_eq_mk Submodule.Quotient.quot_mk_eq_mk

protected theorem eq' {x y : M} : (mk x : M ⧸ p) = (mk : M → M ⧸ p) y ↔ -x + y ∈ p :=
  QuotientAddGroup.eq
#align submodule.quotient.eq' Submodule.Quotient.eq'

protected theorem eq {x y : M} : (mk x : M ⧸ p) = (mk y : M ⧸ p) ↔ x - y ∈ p :=
  (Submodule.Quotient.eq' p).trans (leftRel_apply.symm.trans p.quotientRel_r_def)
#align submodule.quotient.eq Submodule.Quotient.eq

instance : Zero (M ⧸ p) :=
  ⟨mk 0⟩

instance : Inhabited (M ⧸ p) :=
  ⟨0⟩

@[simp]
theorem mk_zero : mk 0 = (0 : M ⧸ p) :=
  rfl
#align submodule.quotient.mk_zero Submodule.Quotient.mk_zero

@[simp]
theorem mk_eq_zero : (mk x : M ⧸ p) = 0 ↔ x ∈ p := by simpa using (Quotient.eq' p : mk x = 0 ↔ _)
#align submodule.quotient.mk_eq_zero Submodule.Quotient.mk_eq_zero

instance addCommGroup : AddCommGroup (M ⧸ p) :=
  QuotientAddGroup.Quotient.addCommGroup p.toAddSubgroup
#align submodule.quotient.add_comm_group Submodule.Quotient.addCommGroup

@[simp]
theorem mk_add : (mk (x + y) : M ⧸ p) = (mk x : M ⧸ p) + (mk y : M ⧸ p) :=
  rfl
#align submodule.quotient.mk_add Submodule.Quotient.mk_add

@[simp]
theorem mk_neg : (mk (-x) : M ⧸ p) = -(mk x : M ⧸ p) :=
  rfl
#align submodule.quotient.mk_neg Submodule.Quotient.mk_neg

@[simp]
theorem mk_sub : (mk (x - y) : M ⧸ p) = (mk x : M ⧸ p) - (mk y : M ⧸ p) :=
  rfl
#align submodule.quotient.mk_sub Submodule.Quotient.mk_sub

section SMul

variable {S : Type _} [SMul S R] [SMul S M] [IsScalarTower S R M] (P : Submodule R M)

instance hasSmul' : SMul S (M ⧸ P) :=
  ⟨fun a =>
    Quotient.map' ((· • ·) a) fun x y h =>
      leftRel_apply.mpr <| by simpa using Submodule.smul_mem P (a • (1 : R)) (leftRel_apply.mp h)⟩
#align submodule.quotient.has_smul' Submodule.Quotient.hasSmul'

-- porting note: should this be marked as a `@[default_instance]`?
/-- Shortcut to help the elaborator in the common case. -/
instance hasSmul : SMul R (M ⧸ P) :=
  Quotient.hasSmul' P
#align submodule.quotient.has_smul Submodule.Quotient.hasSmul

@[simp]
theorem mk_smul (r : S) (x : M) : (mk (r • x) : M ⧸ p) = r • mk x :=
  rfl
#align submodule.quotient.mk_smul Submodule.Quotient.mk_smul

instance smulCommClass (T : Type _) [SMul T R] [SMul T M] [IsScalarTower T R M]
    [SMulCommClass S T M] : SMulCommClass S T (M ⧸ P)
    where smul_comm _x _y := Quotient.ind' fun _z => congr_arg mk (smul_comm _ _ _)
#align submodule.quotient.smul_comm_class Submodule.Quotient.smulCommClass

instance isScalarTower (T : Type _) [SMul T R] [SMul T M] [IsScalarTower T R M] [SMul S T]
    [IsScalarTower S T M] : IsScalarTower S T (M ⧸ P)
    where smul_assoc _x _y := Quotient.ind' fun _z => congr_arg mk (smul_assoc _ _ _)
#align submodule.quotient.is_scalar_tower Submodule.Quotient.isScalarTower

instance isCentralScalar [SMul Sᵐᵒᵖ R] [SMul Sᵐᵒᵖ M] [IsScalarTower Sᵐᵒᵖ R M]
    [IsCentralScalar S M] : IsCentralScalar S (M ⧸ P)
    where op_smul_eq_smul _x := Quotient.ind' fun _z => congr_arg mk <| op_smul_eq_smul _ _
#align submodule.quotient.is_central_scalar Submodule.Quotient.isCentralScalar

end SMul

section Module

variable {S : Type _}

instance mulAction' [Monoid S] [SMul S R] [MulAction S M] [IsScalarTower S R M]
    (P : Submodule R M) : MulAction S (M ⧸ P) :=
  Function.Surjective.mulAction mk (surjective_quot_mk _) <| Submodule.Quotient.mk_smul P
#align submodule.quotient.mul_action' Submodule.Quotient.mulAction'

-- porting note: should this be marked as a `@[default_instance]`?
instance mulAction (P : Submodule R M) : MulAction R (M ⧸ P) :=
  Quotient.mulAction' P
#align submodule.quotient.mul_action Submodule.Quotient.mulAction

instance smulZeroClass' [SMul S R] [SMulZeroClass S M] [IsScalarTower S R M] (P : Submodule R M) :
    SMulZeroClass S (M ⧸ P) :=
  ZeroHom.smulZeroClass ⟨mk, mk_zero _⟩ <| Submodule.Quotient.mk_smul P
#align submodule.quotient.smul_zero_class' Submodule.Quotient.smulZeroClass'

-- porting note: should this be marked as a `@[default_instance]`?
instance smulZeroClass (P : Submodule R M) : SMulZeroClass R (M ⧸ P) :=
  Quotient.smulZeroClass' P
#align submodule.quotient.smul_zero_class Submodule.Quotient.smulZeroClass

instance distribSmul' [SMul S R] [DistribSMul S M] [IsScalarTower S R M] (P : Submodule R M) :
    DistribSMul S (M ⧸ P) :=
  Function.Surjective.distribSMul {toFun := mk, map_zero' := rfl, map_add' := fun _ _ => rfl}
    (surjective_quot_mk _) (Submodule.Quotient.mk_smul P)
#align submodule.quotient.distrib_smul' Submodule.Quotient.distribSmul'

-- porting note: should this be marked as a `@[default_instance]`?
instance distribSmul (P : Submodule R M) : DistribSMul R (M ⧸ P) :=
  Quotient.distribSmul' P
#align submodule.quotient.distrib_smul Submodule.Quotient.distribSmul

instance distribMulAction' [Monoid S] [SMul S R] [DistribMulAction S M] [IsScalarTower S R M]
    (P : Submodule R M) : DistribMulAction S (M ⧸ P) :=
  Function.Surjective.distribMulAction {toFun := mk, map_zero' := rfl, map_add' := fun _ _ => rfl}
    (surjective_quot_mk _) (Submodule.Quotient.mk_smul P)
#align submodule.quotient.distrib_mul_action' Submodule.Quotient.distribMulAction'

-- porting note: should this be marked as a `@[default_instance]`?
instance distribMulAction (P : Submodule R M) : DistribMulAction R (M ⧸ P) :=
  Quotient.distribMulAction' P
#align submodule.quotient.distrib_mul_action Submodule.Quotient.distribMulAction

instance module' [Semiring S] [SMul S R] [Module S M] [IsScalarTower S R M] (P : Submodule R M) :
    Module S (M ⧸ P) :=
  Function.Surjective.module _ {toFun := mk, map_zero' := rfl, map_add' := fun _ _ => rfl}
    (surjective_quot_mk _) (Submodule.Quotient.mk_smul P)
#align submodule.quotient.module' Submodule.Quotient.module'

-- porting note: should this be marked as a `@[default_instance]`?
instance module (P : Submodule R M) : Module R (M ⧸ P) :=
  Quotient.module' P
#align submodule.quotient.module Submodule.Quotient.module

variable (S)

/-- The quotient of `P` as an `S`-submodule is the same as the quotient of `P` as an `R`-submodule,
where `P : submodule R M`.
-/
def restrictScalarsEquiv [Ring S] [SMul S R] [Module S M] [IsScalarTower S R M]
    (P : Submodule R M) : (M ⧸ P.restrictScalars S) ≃ₗ[S] M ⧸ P :=
  {
    Quotient.congrRight fun _ _ =>
      Iff.rfl with
    map_add' := fun x y => Quotient.inductionOn₂' x y fun _x' _y' => rfl
    map_smul' := fun _c x => Quotient.inductionOn' x fun _x' => rfl }
#align submodule.quotient.restrict_scalars_equiv Submodule.Quotient.restrictScalarsEquiv

@[simp]
theorem restrictScalarsEquiv_mk [Ring S] [SMul S R] [Module S M] [IsScalarTower S R M]
    (P : Submodule R M) (x : M) :
    restrictScalarsEquiv S P (mk x : M ⧸ P) = (mk x : M ⧸ P) :=
  rfl
#align submodule.quotient.restrict_scalars_equiv_mk Submodule.Quotient.restrictScalarsEquiv_mk

@[simp]
theorem restrictScalarsEquiv_symm_mk [Ring S] [SMul S R] [Module S M] [IsScalarTower S R M]
    (P : Submodule R M) (x : M) :
    (restrictScalarsEquiv S P).symm ((mk : M → M ⧸ P) x) = (mk : M → M ⧸ P) x :=
  rfl
#align submodule.quotient.restrict_scalars_equiv_symm_mk Submodule.Quotient.restrictScalarsEquiv_symm_mk

end Module

theorem mk_surjective : Function.Surjective (@mk _ _ _ _ _ p) := by
  rintro ⟨x⟩
  exact ⟨x, rfl⟩
#align submodule.quotient.mk_surjective Submodule.Quotient.mk_surjective

theorem nontrivial_of_lt_top (h : p < ⊤) : Nontrivial (M ⧸ p) := by
  obtain ⟨x, _, not_mem_s⟩ := SetLike.exists_of_lt h
  refine' ⟨⟨mk x, 0, _⟩⟩
  simpa using not_mem_s
#align submodule.quotient.nontrivial_of_lt_top Submodule.Quotient.nontrivial_of_lt_top

end Quotient

instance QuotientBot.infinite [Infinite M] : Infinite (M ⧸ (⊥ : Submodule R M)) :=
  Infinite.of_injective Submodule.Quotient.mk fun _x _y h =>
    sub_eq_zero.mp <| (Submodule.Quotient.eq ⊥).mp h
#align submodule.quotient_bot.infinite Submodule.QuotientBot.infinite

instance QuotientTop.unique : Unique (M ⧸ (⊤ : Submodule R M))
    where
  default := 0
  uniq x := Quotient.inductionOn' x fun _x => (Submodule.Quotient.eq ⊤).mpr Submodule.mem_top
#align submodule.quotient_top.unique Submodule.QuotientTop.unique

instance QuotientTop.fintype : Fintype (M ⧸ (⊤ : Submodule R M)) :=
  Fintype.ofSubsingleton 0
#align submodule.quotient_top.fintype Submodule.QuotientTop.fintype

variable {p}

theorem subsingleton_quotient_iff_eq_top : Subsingleton (M ⧸ p) ↔ p = ⊤ := by
  constructor
  · rintro h
    refine' eq_top_iff.mpr fun x _ => _
    have : x - 0 ∈ p := (Submodule.Quotient.eq p).mp (Subsingleton.elim _ _)
    rwa [sub_zero] at this
  · rintro rfl
    infer_instance
#align submodule.subsingleton_quotient_iff_eq_top Submodule.subsingleton_quotient_iff_eq_top

theorem unique_quotient_iff_eq_top : Nonempty (Unique (M ⧸ p)) ↔ p = ⊤ :=
  ⟨fun ⟨h⟩ => subsingleton_quotient_iff_eq_top.mp (@Unique.instSubsingleton _ h),
   by
    rintro rfl
    exact ⟨QuotientTop.unique⟩⟩
#align submodule.unique_quotient_iff_eq_top Submodule.unique_quotient_iff_eq_top

variable (p)

noncomputable instance Quotient.fintype [Fintype M] (S : Submodule R M) : Fintype (M ⧸ S) :=
  @_root_.Quotient.fintype _ _ _ fun _ _ => Classical.dec _
#align submodule.quotient.fintype Submodule.Quotient.fintype

theorem card_eq_card_quotient_mul_card [Fintype M] (S : Submodule R M) [DecidablePred (· ∈ S)] :
    Fintype.card M = Fintype.card S * Fintype.card (M ⧸ S) := by
  rw [mul_comm, ← Fintype.card_prod]
  exact Fintype.card_congr AddSubgroup.addGroupEquivQuotientProdAddSubgroup
#align submodule.card_eq_card_quotient_mul_card Submodule.card_eq_card_quotient_mul_card

section

variable {M₂ : Type _} [AddCommGroup M₂] [Module R M₂]

theorem quot_hom_ext (f g : (M ⧸ p) →ₗ[R] M₂) (h : ∀ x : M, f (Quotient.mk x) = g (Quotient.mk x)) :
    f = g :=
  LinearMap.ext fun x => Quotient.inductionOn' x h
#align submodule.quot_hom_ext Submodule.quot_hom_ext

/-- The map from a module `M` to the quotient of `M` by a submodule `p` as a linear map. -/
def mkQ : M →ₗ[R] M ⧸ p where
  toFun := Quotient.mk
  map_add' := by simp
  map_smul' := by simp
#align submodule.mkq Submodule.mkQ

@[simp]
theorem mkQ_apply (x : M) : p.mkQ x = (Quotient.mk x : M ⧸ p) :=
  rfl
#align submodule.mkq_apply Submodule.mkQ_apply

theorem mkQ_surjective (A : Submodule R M) : Function.Surjective A.mkQ := by
  rintro ⟨x⟩; exact ⟨x, rfl⟩
#align submodule.mkq_surjective Submodule.mkQ_surjective

end

variable {R₂ M₂ : Type _} [Ring R₂] [AddCommGroup M₂] [Module R₂ M₂] {τ₁₂ : R →+* R₂}

/-- Two `linear_map`s from a quotient module are equal if their compositions with
`submodule.mkQ` are equal.

See note [partially-applied ext lemmas]. -/
@[ext 1100] -- porting note: increase priority so this applies before `LinearMap.ext`
theorem linearMap_qext ⦃f g : M ⧸ p →ₛₗ[τ₁₂] M₂⦄ (h : f.comp p.mkQ = g.comp p.mkQ) : f = g :=
  LinearMap.ext fun x => Quotient.inductionOn' x <| (LinearMap.congr_fun h : _)
#align submodule.linear_map_qext Submodule.linearMap_qext

/-- The map from the quotient of `M` by a submodule `p` to `M₂` induced by a linear map `f : M → M₂`
vanishing on `p`, as a linear map. -/
def liftQ (f : M →ₛₗ[τ₁₂] M₂) (h : p ≤ ker f) : M ⧸ p →ₛₗ[τ₁₂] M₂ :=
  { QuotientAddGroup.lift p.toAddSubgroup f.toAddMonoidHom h with
    map_smul' := by rintro a ⟨x⟩; exact f.map_smulₛₗ a x }
#align submodule.liftq Submodule.liftQ

@[simp]
theorem liftQ_apply (f : M →ₛₗ[τ₁₂] M₂) {h} (x : M) : p.liftQ f h (Quotient.mk x) = f x :=
  rfl
#align submodule.liftq_apply Submodule.liftQ_apply

@[simp]
theorem liftQ_mkQ (f : M →ₛₗ[τ₁₂] M₂) (h) : (p.liftQ f h).comp p.mkQ = f := by ext; rfl
#align submodule.liftq_mkq Submodule.liftQ_mkQ

/-- Special case of `submodule.liftQ` when `p` is the span of `x`. In this case, the condition on
`f` simply becomes vanishing at `x`.-/
def liftQSpanSingleton (x : M) (f : M →ₛₗ[τ₁₂] M₂) (h : f x = 0) : (M ⧸ R ∙ x) →ₛₗ[τ₁₂] M₂ :=
  (R ∙ x).liftQ f <| by rw [span_singleton_le_iff_mem, LinearMap.mem_ker, h]
#align submodule.liftq_span_singleton Submodule.liftQSpanSingleton

@[simp]
theorem liftQSpanSingleton_apply (x : M) (f : M →ₛₗ[τ₁₂] M₂) (h : f x = 0) (y : M) :
    liftQSpanSingleton x f h (Quotient.mk y) = f y :=
  rfl
#align submodule.liftq_span_singleton_apply Submodule.liftQSpanSingleton_apply

@[simp]
theorem range_mkQ : range p.mkQ = ⊤ :=
  eq_top_iff'.2 <| by rintro ⟨x⟩; exact ⟨x, rfl⟩
#align submodule.range_mkq Submodule.range_mkQ

@[simp]
theorem ker_mkQ : ker p.mkQ = p := by ext; simp
#align submodule.ker_mkq Submodule.ker_mkQ

theorem le_comap_mkQ (p' : Submodule R (M ⧸ p)) : p ≤ comap p.mkQ p' := by
  simpa using (comap_mono bot_le : ker p.mkQ ≤ comap p.mkQ p')
#align submodule.le_comap_mkq Submodule.le_comap_mkQ

@[simp]
theorem mkQ_map_self : map p.mkQ p = ⊥ := by
  rw [eq_bot_iff, map_le_iff_le_comap, comap_bot, ker_mkQ]
#align submodule.mkq_map_self Submodule.mkQ_map_self

@[simp]
theorem comap_map_mkQ : comap p.mkQ (map p.mkQ p') = p ⊔ p' := by simp [comap_map_eq, sup_comm]
#align submodule.comap_map_mkq Submodule.comap_map_mkQ

@[simp]
theorem map_mkQ_eq_top : map p.mkQ p' = ⊤ ↔ p ⊔ p' = ⊤ := by
  simp only [map_eq_top_iff p.range_mkQ, sup_comm, ker_mkQ]
#align submodule.map_mkq_eq_top Submodule.map_mkQ_eq_top

variable (q : Submodule R₂ M₂)

/-- The map from the quotient of `M` by submodule `p` to the quotient of `M₂` by submodule `q` along
`f : M → M₂` is linear. -/
def mapQ (f : M →ₛₗ[τ₁₂] M₂) (h : p ≤ comap f q) : M ⧸ p →ₛₗ[τ₁₂] M₂ ⧸ q :=
  p.liftQ (q.mkQ.comp f) <| by simpa [ker_comp] using h
#align submodule.mapq Submodule.mapQ

@[simp]
theorem mapQ_apply (f : M →ₛₗ[τ₁₂] M₂) {h} (x : M) :
    mapQ p q f h (Quotient.mk x : M ⧸ p) = (Quotient.mk (f x) : M₂ ⧸ q) :=
  rfl
#align submodule.mapq_apply Submodule.mapQ_apply

theorem mapQ_mkQ (f : M →ₛₗ[τ₁₂] M₂) {h} : (mapQ p q f h).comp p.mkQ = q.mkQ.comp f := by
  ext x; rfl
#align submodule.mapq_mkq Submodule.mapQ_mkQ

@[simp]
theorem mapQ_zero (h : p ≤ q.comap (0 : M →ₛₗ[τ₁₂] M₂) := (by simp)) :
    p.mapQ q (0 : M →ₛₗ[τ₁₂] M₂) h = 0 := by
  ext
  simp
#align submodule.mapq_zero Submodule.mapQ_zero

/-- Given submodules `p ⊆ M`, `p₂ ⊆ M₂`, `p₃ ⊆ M₃` and maps `f : M → M₂`, `g : M₂ → M₃` inducing
`mapQ f : M ⧸ p → M₂ ⧸ p₂` and `mapQ g : M₂ ⧸ p₂ → M₃ ⧸ p₃` then
`mapQ (g ∘ f) = (mapQ g) ∘ (mapQ f)`. -/
theorem mapQ_comp {R₃ M₃ : Type _} [Ring R₃] [AddCommGroup M₃] [Module R₃ M₃] (p₂ : Submodule R₂ M₂)
    (p₃ : Submodule R₃ M₃) {τ₂₃ : R₂ →+* R₃} {τ₁₃ : R →+* R₃} [RingHomCompTriple τ₁₂ τ₂₃ τ₁₃]
    (f : M →ₛₗ[τ₁₂] M₂) (g : M₂ →ₛₗ[τ₂₃] M₃) (hf : p ≤ p₂.comap f) (hg : p₂ ≤ p₃.comap g)
    (h := hf.trans (comap_mono hg)) :
    p.mapQ p₃ (g.comp f) h = (p₂.mapQ p₃ g hg).comp (p.mapQ p₂ f hf) := by
  ext
  simp
#align submodule.mapq_comp Submodule.mapQ_comp

@[simp]
theorem mapQ_id (h : p ≤ p.comap LinearMap.id := (by rw [comap_id])) :
    p.mapQ p LinearMap.id h = LinearMap.id := by
  ext
  simp
#align submodule.mapq_id Submodule.mapQ_id

theorem mapQ_pow {f : M →ₗ[R] M} (h : p ≤ p.comap f) (k : ℕ)
    (h' : p ≤ p.comap (f ^ k) := p.le_comap_pow_of_le_comap h k) :
    p.mapQ p (f ^ k) h' = p.mapQ p f h ^ k := by
  induction' k with k ih
  · simp [LinearMap.one_eq_id]
  · simp only [LinearMap.iterate_succ]
    -- porting note: why does any of these `optParams` need to be applied? Why didn't `simp` handle
    -- all of this for us?
    convert mapQ_comp p p p f (f ^ k) h (p.le_comap_pow_of_le_comap h k)
      (h.trans (comap_mono <| p.le_comap_pow_of_le_comap h k))
    exact (ih _).symm
#align submodule.mapq_pow Submodule.mapQ_pow

theorem comap_liftQ (f : M →ₛₗ[τ₁₂] M₂) (h) : q.comap (p.liftQ f h) = (q.comap f).map (mkQ p) :=
  le_antisymm (by rintro ⟨x⟩ hx; exact ⟨_, hx, rfl⟩)
    (by rw [map_le_iff_le_comap, ← comap_comp, liftQ_mkQ])
#align submodule.comap_liftq Submodule.comap_liftQ

theorem map_liftQ [RingHomSurjective τ₁₂] (f : M →ₛₗ[τ₁₂] M₂) (h) (q : Submodule R (M ⧸ p)) :
    q.map (p.liftQ f h) = (q.comap p.mkQ).map f :=
  le_antisymm (by rintro _ ⟨⟨x⟩, hxq, rfl⟩; exact ⟨x, hxq, rfl⟩)
    (by rintro _ ⟨x, hxq, rfl⟩; exact ⟨Quotient.mk x, hxq, rfl⟩)
#align submodule.map_liftq Submodule.map_liftQ

theorem ker_liftQ (f : M →ₛₗ[τ₁₂] M₂) (h) : ker (p.liftQ f h) = (ker f).map (mkQ p) :=
  comap_liftQ _ _ _ _
#align submodule.ker_liftq Submodule.ker_liftQ

theorem range_liftQ [RingHomSurjective τ₁₂] (f : M →ₛₗ[τ₁₂] M₂) (h) :
    range (p.liftQ f h) = range f := by simpa only [range_eq_map] using map_liftQ _ _ _ _
#align submodule.range_liftq Submodule.range_liftQ

theorem ker_liftQ_eq_bot (f : M →ₛₗ[τ₁₂] M₂) (h) (h' : ker f ≤ p) : ker (p.liftQ f h) = ⊥ := by
  rw [ker_liftQ, le_antisymm h h', mkQ_map_self]
#align submodule.ker_liftq_eq_bot Submodule.ker_liftQ_eq_bot

/-- The correspondence theorem for modules: there is an order isomorphism between submodules of the
quotient of `M` by `p`, and submodules of `M` larger than `p`. -/
def comapMkQRelIso : Submodule R (M ⧸ p) ≃o { p' : Submodule R M // p ≤ p' }
    where
  toFun p' := ⟨comap p.mkQ p', le_comap_mkQ p _⟩
  invFun q := map p.mkQ q
  left_inv p' := map_comap_eq_self <| by simp
  right_inv := fun ⟨q, hq⟩ => Subtype.ext_val <| by simpa [comap_map_mkQ p]
  map_rel_iff' := comap_le_comap_iff <| range_mkQ _
#align submodule.comap_mkq.rel_iso Submodule.comapMkQRelIso

/-- The ordering on submodules of the quotient of `M` by `p` embeds into the ordering on submodules
of `M`. -/
def comapMkQOrderEmbedding : Submodule R (M ⧸ p) ↪o Submodule R M :=
  (RelIso.toRelEmbedding <| comapMkQRelIso p).trans (Subtype.relEmbedding (· ≤ ·) _)

#align submodule.comap_mkq.order_embedding Submodule.comapMkQOrderEmbedding

@[simp]
theorem comapMkQOrderEmbedding_eq (p' : Submodule R (M ⧸ p)) :
    comapMkQOrderEmbedding p p' = comap p.mkQ p' :=
  rfl
#align submodule.comap_mkq_embedding_eq Submodule.comapMkQOrderEmbedding_eq

theorem span_preimage_eq [RingHomSurjective τ₁₂] {f : M →ₛₗ[τ₁₂] M₂} {s : Set M₂} (h₀ : s.Nonempty)
    (h₁ : s ⊆ range f) : span R (f ⁻¹' s) = (span R₂ s).comap f := by
  suffices (span R₂ s).comap f ≤ span R (f ⁻¹' s) by exact le_antisymm (span_preimage_le f s) this
  have hk : ker f ≤ span R (f ⁻¹' s) :=
    by
    let y := Classical.choose h₀
    have hy : y ∈ s := Classical.choose_spec h₀
    rw [ker_le_iff]
    use y, h₁ hy
    rw [← Set.singleton_subset_iff] at hy
    exact Set.Subset.trans subset_span (span_mono (Set.preimage_mono hy))
  rw [← left_eq_sup] at hk
  rw [range_coe f] at h₁
  rw [hk, ← LinearMap.map_le_map_iff, map_span, map_comap_eq, Set.image_preimage_eq_of_subset h₁]
  exact inf_le_right
#align submodule.span_preimage_eq Submodule.span_preimage_eq

/-- If `P` is a submodule of `M` and `Q` a submodule of `N`,
and `f : M ≃ₗ N` maps `P` to `Q`, then `M ⧸ P` is equivalent to `N ⧸ Q`. -/
@[simps]
def Quotient.equiv {N : Type _} [AddCommGroup N] [Module R N] (P : Submodule R M)
    (Q : Submodule R N) (f : M ≃ₗ[R] N) (hf : P.map f = Q) : (M ⧸ P) ≃ₗ[R] N ⧸ Q :=
  {
    P.mapQ Q (f : M →ₗ[R] N) fun x hx =>
      hf ▸
        Submodule.mem_map_of_mem
          hx with
    toFun := P.mapQ Q (f : M →ₗ[R] N) fun x hx => hf ▸ Submodule.mem_map_of_mem hx
    invFun :=
      Q.mapQ P (f.symm : N →ₗ[R] M) fun x hx =>
        by
        rw [← hf, Submodule.mem_map] at hx
        obtain ⟨y, hy, rfl⟩ := hx
        simpa
    left_inv := fun x => Quotient.inductionOn' x (by simp)
    right_inv := fun x => Quotient.inductionOn' x (by simp) }
#align submodule.quotient.equiv Submodule.Quotient.equiv
#align submodule.quotient.equiv_apply Submodule.Quotient.equiv_apply

@[simp]
theorem Quotient.equiv_symm {R M N : Type _} [CommRing R] [AddCommGroup M] [Module R M]
    [AddCommGroup N] [Module R N] (P : Submodule R M) (Q : Submodule R N) (f : M ≃ₗ[R] N)
    (hf : P.map f = Q) :
    (Quotient.equiv P Q f hf).symm =
      Quotient.equiv Q P f.symm ((Submodule.map_symm_eq_iff f).mpr hf) :=
  rfl
#align submodule.quotient.equiv_symm Submodule.Quotient.equiv_symm

@[simp]
theorem Quotient.equiv_trans {N O : Type _} [AddCommGroup N] [Module R N] [AddCommGroup O]
    [Module R O] (P : Submodule R M) (Q : Submodule R N) (S : Submodule R O) (e : M ≃ₗ[R] N)
    (f : N ≃ₗ[R] O) (he : P.map e = Q) (hf : Q.map f = S) (hef : P.map (e.trans f) = S) :
    Quotient.equiv P S (e.trans f) hef =
      (Quotient.equiv P Q e he).trans (Quotient.equiv Q S f hf) := by
  ext
  -- `simp` can deal with `hef` depending on `e` and `f`
  simp only [Quotient.equiv_apply, LinearEquiv.trans_apply, LinearEquiv.coe_trans]
  -- `rw` can deal with `mapQ_comp` needing extra hypotheses coming from the RHS
  rw [mapQ_comp, LinearMap.comp_apply]
#align submodule.quotient.equiv_trans Submodule.Quotient.equiv_trans

end Submodule

open Submodule

namespace LinearMap

section Ring

variable {R M R₂ M₂ R₃ M₃ : Type _}

variable [Ring R] [Ring R₂] [Ring R₃]

variable [AddCommMonoid M] [AddCommGroup M₂] [AddCommMonoid M₃]

variable [Module R M] [Module R₂ M₂] [Module R₃ M₃]

variable {τ₁₂ : R →+* R₂} {τ₂₃ : R₂ →+* R₃} {τ₁₃ : R →+* R₃}

variable [RingHomCompTriple τ₁₂ τ₂₃ τ₁₃] [RingHomSurjective τ₁₂]

theorem range_mkQ_comp (f : M →ₛₗ[τ₁₂] M₂) : f.range.mkQ.comp f = 0 :=
  LinearMap.ext fun x => by simp
#align linear_map.range_mkq_comp LinearMap.range_mkQ_comp

/-- An epimorphism is surjective. -/
theorem range_eq_top_of_cancel {f : M →ₛₗ[τ₁₂] M₂}
    (h : ∀ u v : M₂ →ₗ[R₂] M₂ ⧸ (range f), u.comp f = v.comp f → u = v) : range f = ⊤ := by
  have h₁ : (0 : M₂ →ₗ[R₂] M₂ ⧸ (range f)).comp f = 0 := zero_comp _
  rw [← Submodule.ker_mkQ (range f), ← h 0 f.range.mkQ (Eq.trans h₁ (range_mkQ_comp _).symm)]
  exact ker_zero
#align linear_map.range_eq_top_of_cancel LinearMap.range_eq_top_of_cancel

end Ring

end LinearMap

open LinearMap

namespace Submodule

variable {R M : Type _} {r : R} {x y : M} [Ring R] [AddCommGroup M] [Module R M]

variable (p p' : Submodule R M)

/-- If `p = ⊥`, then `M / p ≃ₗ[R] M`. -/
def quotEquivOfEqBot (hp : p = ⊥) : (M ⧸ p) ≃ₗ[R] M :=
  LinearEquiv.ofLinear (p.liftQ id <| hp.symm ▸ bot_le) p.mkQ (liftQ_mkQ _ _ _) <|
    p.quot_hom_ext _ LinearMap.id fun _ => rfl
#align submodule.quot_equiv_of_eq_bot Submodule.quotEquivOfEqBot

@[simp]
theorem quotEquivOfEqBot_apply_mk (hp : p = ⊥) (x : M) :
    p.quotEquivOfEqBot hp (Quotient.mk x : M ⧸ p) = x :=
  rfl
#align submodule.quot_equiv_of_eq_bot_apply_mk Submodule.quotEquivOfEqBot_apply_mk

@[simp]
theorem quotEquivOfEqBot_symm_apply (hp : p = ⊥) (x : M) :
    (p.quotEquivOfEqBot hp).symm x = (Quotient.mk x : M ⧸ p) :=
  rfl
#align submodule.quot_equiv_of_eq_bot_symm_apply Submodule.quotEquivOfEqBot_symm_apply

@[simp]
theorem coe_quotEquivOfEqBot_symm (hp : p = ⊥) :
    ((p.quotEquivOfEqBot hp).symm : M →ₗ[R] M ⧸ p) = p.mkQ :=
  rfl
#align submodule.coe_quot_equiv_of_eq_bot_symm Submodule.coe_quotEquivOfEqBot_symm

/-- Quotienting by equal submodules gives linearly equivalent quotients. -/
def quotEquivOfEq (h : p = p') : (M ⧸ p) ≃ₗ[R] M ⧸ p' :=
  {
    @Quotient.congr _ _ (quotientRel p) (quotientRel p') (Equiv.refl _) fun a b =>
      by
      subst h
      rfl with
    map_add' := by
      rintro ⟨x⟩ ⟨y⟩
      rfl
    map_smul' := by
      rintro x ⟨y⟩
      rfl }
#align submodule.quot_equiv_of_eq Submodule.quotEquivOfEq

@[simp]
theorem quotEquivOfEq_mk (h : p = p') (x : M) :
    Submodule.quotEquivOfEq p p' h (Submodule.Quotient.mk x : M ⧸ p) =
      (Submodule.Quotient.mk x : M ⧸ p') :=
  rfl
#align submodule.quot_equiv_of_eq_mk Submodule.quotEquivOfEq_mk

@[simp]
theorem Quotient.equiv_refl (P : Submodule R M) (Q : Submodule R M)
    (hf : P.map (LinearEquiv.refl R M : M →ₗ[R] M) = Q) :
    Quotient.equiv P Q (LinearEquiv.refl R M) hf = quotEquivOfEq _ _ (by simpa using hf) :=
  rfl
#align submodule.quotient.equiv_refl Submodule.Quotient.equiv_refl

end Submodule

end Ring

section CommRing

variable {R M M₂ : Type _} {r : R} {x y : M} [CommRing R] [AddCommGroup M] [Module R M]
  [AddCommGroup M₂] [Module R M₂] (p : Submodule R M) (q : Submodule R M₂)

namespace Submodule

/-- Given modules `M`, `M₂` over a commutative ring, together with submodules `p ⊆ M`, `q ⊆ M₂`,
the natural map $\{f ∈ Hom(M, M₂) | f(p) ⊆ q \} \to Hom(M/p, M₂/q)$ is linear. -/
def mapQLinear : compatibleMaps p q →ₗ[R] M ⧸ p →ₗ[R] M₂ ⧸ q
    where
  toFun f := mapQ _ _ f.val f.property
  map_add' x y := by
    ext
    rfl
  map_smul' c f := by
    ext
    rfl
#align submodule.mapq_linear Submodule.mapQLinear

end Submodule

end CommRing

end deinstance_nonassocring


/-
Copyright (c) 2022 Kevin Buzzard. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author : Kevin Buzzard
-/

import tactic -- imports all the Lean tactics

/-!

# Sets in Lean, sheet 6 : equality of sets

Sets are extensional objects to mathematicians, which means that
if two sets have the same elements, then they are equal.

## Tactics

Tactics you will need to know for this sheet:

* `ext`

### The `ext` tactic

If the goal is `⊢ A = B` where `A` and `B` are subsets of `X`, then
the tactic `ext x,` will create a hypothesis `x : X` and change
the goal to `x ∈ A ↔ x ∈ B`.

-/

open set

variables
  (X : Type) -- Everything will be a subset of `X`
  (A B C D E : set X) -- A,B,C,D,E are subsets of `X`
  (x y z : X) -- x,y,z are elements of `X` or, more precisely, terms of type `X`

example : A ⊆ B → B ⊆ A → A = B :=
begin
  sorry
end

example : A ∪ A = A :=
begin
  sorry
end

example : A ∩ A = A :=
begin
  sorry
end

example : A ∩ B = B ∩ A :=
begin
  sorry
end

example : A ∩ (B ∩ C) = (A ∩ B) ∩ C :=
begin
  sorry
end

example : A ∪ (B ∪ C) = (A ∪ B) ∪ C :=
begin
  sorry
end


import tactic

-- Основано на https://github.com/ImperialCollegeLondon/formalising-mathematics/tree/master/src/week_7
-- Я убрал довольно много материала оттуда, посмотрите по возможности оригинал, в котором Kevin уходит гораздо глубже в концепцию `quotient`
-- Больше в книге Theorem Proving in Lean: https://leanprover.github.io/theorem_proving_in_lean/axioms_and_computation.html#quotients

-- В этом файле мы изучим конструкцию `quotient`
-- И построим целые числа как классы эквивалентности пар натуральных чисел (a, b)
-- Где (a, b) ≈ (c, d) ↔ a + d = b + c
-- В первом приближении `quotient` можно описать как "тип классов эквивалентности по бинарному отношению"
-- Пусть у нас есть тип `α` и отношение эквивалентности `r : α → α → Prop`

-- `abbreviation` это просто синтаксический синоним
abbreviation N2 := ℕ × ℕ

namespace N2

section product

def foo : ℕ × ℕ := (3, 4)

#reduce (foo.fst, foo.snd)
-- Аналогично можно писать `foo.1` или `foo.2`

-- Чтобы доказать равенство двух пар, можно использовать `ext`
example (X Y : Type) (s t : X × Y) (h1 : s.fst = t.fst) (h2 : s.snd = t.snd) :
  s = t :=
begin
  ext,
  { exact h1 },
  { exact h2 },
end

-- Чтобы разбить пару `x` на два натуральных числа, можно использовать `cases x with a b`
example (A B : Type) (x : A × B) : x = (x.1, x.2) :=
begin
  cases x with a b,
  -- ⊢ (a, b) = ((a, b).fst, (a, b).snd)
  dsimp only, -- упрощает `(a, b).fst` до `a`.
  -- ⊢ (a, b) = (a, b)
  refl,
end

end product

-- Как построить целые числа на основе натуральных?
-- Стандартная конструкция: целое число либо `n : ℕ`, либо `-n-1`
#check ℤ

-- Иначе целые числа можно представить, как разность двух натуральных чисел, например, -1 = 3 - 4
-- Такое представление неоднозначно, 3 - 4 = 5 - 6 = ...
-- В каком случае две пары задают одно число? a - b = c - d ↔ a + d = c + b
-- Определим отношение `r : N2 → N2 → Prop`: r (a, b) (c, d) = a + d = c + b

def r (ab cd : N2) : Prop :=
ab.1 + cd.2 = cd.1 + ab.2

lemma r_def (ab cd : N2) : r ab cd ↔ ab.1 + cd.2 = cd.1 + ab.2 := iff.rfl

lemma r_def' (a b c d : ℕ) : r (a,b) (c,d) ↔ a + d = c + b := iff.rfl

def r_refl : reflexive r :=
begin
  -- `unfold reflexive` раскроет определение и покажет, как оно определено
  -- не забывайте, что N2 = ℕ × ℕ, поэтому можно делать `rintro ⟨a, b⟩`
  sorry,
end

def r_symm : symmetric r :=
begin
  sorry,
end

def r_trans : transitive r :=
begin
  sorry,
end

-- Определим инстанс класса `setoid`: это просто отношение эквивалентности на `N2`
instance setoid : setoid N2 := ⟨r, r_refl, r_symm, r_trans⟩

-- Теперь можно использовать `≈` (\~~ или \approx)

example (x y : N2) : x ≈ y ↔ r x y := iff.rfl

-- Добавим simp-леммы для упрощения жизни в будущем
@[simp] lemma equiv_def (ab cd : N2) : ab ≈ cd ↔ ab.1 + cd.2 = cd.1 + ab.2 :=
begin
  refl
end

@[simp] lemma equiv_def' (a b c d : ℕ) : (a,b) ≈ (c,d) ↔ a + d = c + b := iff.rfl

end N2

open N2

-- Определим Z как `quotient` по определенному отношению эквивалентности
def Z := quotient N2.setoid

namespace Z

-- По заданной паре типа N2 можно легко получить элемент типа Z как `quotient.mk x`
-- Или же `⟦x⟧`

def bar : Z := quotient.mk foo -- соответствует целому числу -1.

example : bar = ⟦foo⟧ := rfl

-- Посмотрим на API `quotient`

example (x y : N2) : x ≈ y → ⟦x⟧ = ⟦y⟧ := quotient.sound

example (x y : N2) : ⟦x⟧ = ⟦y⟧ → x ≈ y := quotient.exact

example (x y : N2) : ⟦x⟧ = ⟦y⟧ ↔ x ≈ y := quotient.eq

-- Определим и докажем все операции над Z, дойдя до коммутативного кольца

-- Определим 0 и 1:

def zero : Z := ⟦(0, 0)⟧

def one : Z := ⟦(1, 0)⟧

instance : has_zero Z := ⟨zero⟩
instance : has_one Z := ⟨one⟩

@[simp] lemma zero_def : (0 : Z) = ⟦(0, 0)⟧ := rfl
@[simp] lemma one_def : (1 : Z) = ⟦(1, 0)⟧ := rfl

/-
Определим обратное по сложению число. Как определить функцию для `quotient`?

1) Определим вспомогательное отображение `N2 → Z`: по `(a,b)` выдаем `⟦(b,a)⟧`
2) Докажем, что эта функция константна на классах эквивалентности:
  `(a, b) ≈ (c, d) → ⟦(b, a)⟧ = ⟦(d, c)⟧`
3) Используем `quotient.lift`, чтобы получить функцию `Z → Z`.

-/

def neg_aux (ab : N2) : Z := ⟦(ab.2, ab.1)⟧

@[simp] lemma neg_aux_def (ab : N2) : neg_aux ab = ⟦(ab.2, ab.1)⟧ := rfl

def neg : Z → Z := quotient.lift neg_aux
begin
  -- ⊢ ∀ (a b : N2), a ≈ b → neg_aux a = neg_aux b
  intros a b rab,
  sorry,
end

-- нотация `-z`
instance : has_neg Z := ⟨neg⟩

@[simp] lemma neg_def (a b : ℕ) : (-⟦(a, b)⟧ : Z) = ⟦(b, a)⟧ := rfl

/-
Определим сложение. Если бы мы определяли сложение так же, как отрицание, то пришлось бы использовать
`lift` дважды: сначала показать, что функция независима по первому аргументу, потом по второму.
Есть функция `quotient.lift₂`, которая позволяет взять функцию `f : A → B → C`,
и доказательство, что она не меняет значение, если заменить первые два аргумента на эквивалентные, и выдает функцию `A/~ → B/~ → C`.
-/

-- Вспомогательное определение сложения (note `(a-b)+(c-d)=(a+c)-(b+d)` )
def add_aux (ab cd : N2) : Z := ⟦(ab.1 + cd.1, ab.2 + cd.2)⟧

-- И simp-лемма для него
@[simp] lemma add_aux_def (ab cd : N2) : add_aux ab cd = ⟦(ab.1 + cd.1, ab.2 + cd.2)⟧ := rfl

def add : Z → Z → Z := quotient.lift₂ add_aux
begin
  rintro ⟨a₁, b₁⟩ ⟨a₂, b₂⟩ ⟨c₁, d₁⟩ ⟨c₂, d₂⟩ rab rcd,
  sorry,
end

instance : has_add Z := ⟨add⟩

@[simp] lemma add_def (a b c d : ℕ) :
  (⟦(a, b)⟧ + ⟦(c, d)⟧ : Z) = ⟦(a+c, b+d)⟧ :=
rfl

-- И определим вычитание целых чисел
def sub (x y : Z) : Z := x + -y

instance : has_sub Z := ⟨sub⟩

-- Покажем, что Z - коммутативная группа по сложению

def add_comm_group : add_comm_group Z :=
{ zero := 0,
  add := (+),
  neg := has_neg.neg,
  sub := has_sub.sub,
  -- Используйте `quotient.induction_on` для доказательства лемм про свойства операций над `quotient`
  -- "Если для всех `x : N2` верно `p ⟦x⟧`, то для всех `y : Z` верно p y"
  zero_add := begin
    intro x,
    apply quotient.induction_on x, clear x,
    rintro ⟨a, b⟩,
    simp,
  end,
  add_zero := begin
    sorry,
  end,
  -- Для версий с 2 и 3 аргументами есть `quotient.induction_on₂` и `quotient.induction_on₃`
  -- Не забывайте про `linarith` и `ring`
  add_assoc := begin
    sorry,
  end,
  add_left_neg := begin
    sorry,
  end,
  add_comm := begin
    sorry,
  end,
}

-- Умножение: `(a-b)*(c-d) = (a*c+b*d)-(a*d+b*c)`
def mul_aux (ab cd : N2) : N2 :=
  (ab.1 * cd.1 + ab.2 * cd.2, ab.1 * cd.2 + ab.2 * cd.1)

@[simp] lemma mul_aux_def (a b c d : ℕ) :
  mul_aux (a,b) (c,d) = (a*c+b*d,a*d+b*c) := rfl

-- Для разнообразия определим умножение слегка иначе.
-- Вместо использования `quotient.lift₂` (который превращает `N2 → N2 → Z` в `Z → Z → Z`),
-- используем `quotient.map₂`, который превращает `N2 → N2 → N2` в `Z → Z → Z`.
-- `nlinarith` умеет доказывать некоторые цели, содержащие нелинейные [не]равенства
def mul : Z → Z → Z := quotient.map₂ mul_aux
begin
  sorry,
end

instance : has_mul Z := ⟨mul⟩

@[simp] lemma mul_def (a b c d : ℕ) :
  (⟦(a, b)⟧ * ⟦(c, d)⟧ : Z) = ⟦(a*c+b*d, a*d+b*c)⟧ := rfl

-- И наконец, докажем, что Z - коммутативное кольцо
def comm_ring : comm_ring Z :=
{ one := 1,
  add := (+),
  mul := (*),
  mul_assoc := begin
    sorry,
  end,
  one_mul := begin
    sorry,
  end,
  mul_one := begin
    sorry,
  end,
  left_distrib := begin
    sorry,
  end,
  right_distrib := begin
    sorry,
  end,
  mul_comm := begin
    sorry,
  end,
  ..add_comm_group
}

end Z


-- ---------------------------------------------------------------------
-- Ejercicio. Sea x un número real. Demostrar que si
--    x ≠ 0
-- entonces
--    x < 0 ∨ x > 0
 -- ----------------------------------------------------------------------

import data.real.basic

example
  {x : ℝ}
  (h : x ≠ 0)
  : x < 0 ∨ x > 0 :=
begin
  rcases lt_trichotomy x 0 with xlt | xeq | xgt,
  { left,
    exact xlt },
  { contradiction },
  { right,
    exact xgt },
end

-- Prueba
-- ======

/-
x : ℝ,
h : x ≠ 0
⊢ x < 0 ∨ x > 0
  >> rcases lt_trichotomy x 0 with xlt | xeq | xgt,
| | xlt : x < 0
| | ⊢ x < 0 ∨ x > 0
| |   >> { left,
| | ⊢ x < 0
| |   >>  exact xlt },
| h : x ≠ 0,
| xeq : x = 0
| ⊢ x < 0 ∨ x > 0
  >> { contradiction },
h : x ≠ 0,
xgt : 0 < x
⊢ x < 0 ∨ x > 0
  >> { right,
⊢ x > 0
  >>  exact xgt },
no goals
-/

-- Comentarios:
-- 1. La táctica (rcases h with h1 | h2 | h3) si el objetivo es (P ∨ Q ∨ R)
--    crea tres casos añadiéndole al primero la hipótesis (h1 : P), al
--    segundo (h2 : Q) y al tercero (h3 : R).


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

import tactic.linarith.verification
import tactic.linarith.preprocessing

/-!
# `linarith`: solving linear arithmetic goals

`linarith` is a tactic for solving goals with linear arithmetic.

Suppose we have a set of hypotheses in `n` variables
`S = {a₁x₁ + a₂x₂ + ... + aₙxₙ R b₁x₁ + b₂x₂ + ... + bₙxₙ}`,
where `R ∈ {<, ≤, =, ≥, >}`.
Our goal is to determine if the inequalities in `S` are jointly satisfiable, that is, if there is
an assignment of values to `x₁, ..., xₙ` such that every inequality in `S` is true.

Specifically, we aim to show that they are *not* satisfiable. This amounts to proving a
contradiction. If our goal is also a linear inequality, we negate it and move it to a hypothesis
before trying to prove `false`.

When the inequalities are over a dense linear order, `linarith` is a decision procedure: it will
prove `false` if and only if the inequalities are unsatisfiable. `linarith` will also run on some
types like `ℤ` that are not dense orders, but it will fail to prove `false` on some unsatisfiable
problems. It will run over concrete types like `ℕ`, `ℚ`, and `ℝ`, as well as abstract types that
are instances of `linear_ordered_comm_ring`.

## Algorithm sketch

First, the inequalities in the set `S` are rearranged into the form `tᵢ Rᵢ 0`, where
`Rᵢ ∈ {<, ≤, =}` and each `tᵢ` is of the form `∑ cⱼxⱼ`.

`linarith` uses an untrusted oracle to search for a certificate of unsatisfiability.
The oracle searches for a list of natural number coefficients `kᵢ` such that `∑ kᵢtᵢ = 0`, where for
at least one `i`, `kᵢ > 0` and `Rᵢ = <`.

Given a list of such coefficients, `linarith` verifies that `∑ kᵢtᵢ = 0` using a normalization
tactic such as `ring`. It proves that `∑ kᵢtᵢ < 0` by transitivity, since each component of the sum
is either equal to, less than or equal to, or less than zero by hypothesis. This produces a
contradiction.

## Preprocessing

`linarith` does some basic preprocessing before running. Most relevantly, inequalities over natural
numbers are cast into inequalities about integers, and rational division by numerals is canceled
into multiplication. We do this so that we can guarantee the coefficients in the certificate are
natural numbers, which allows the tactic to solve goals over types that are not fields.

Preprocessors are allowed to branch, that is, to case split on disjunctions. `linarith` will succeed
overall if it succeeds in all cases. This leads to exponential blowup in the number of `linarith`
calls, and should be used sparingly. The default preprocessor set does not include case splits.

## Fourier-Motzkin elimination

The oracle implemented to search for certificates uses Fourier-Motzkin variable elimination.
This technique transorms a set of inequalities in `n` variables to an equisatisfiable set in `n - 1`
variables. Once all variables have been eliminated, we conclude that the original set was
unsatisfiable iff the comparison `0 < 0` is in the resulting set.

While performing this elimination, we track the history of each derived comparison. This allows us
to represent any comparison at any step as a positive combination of comparisons from the original
set. In particular, if we derive `0 < 0`, we can find our desired list of coefficients
by counting how many copies of each original comparison appear in the history.

## Implementation details

`linarith` homogenizes numerical constants: the expression `1` is treated as a variable `t₀`.

Often `linarith` is called on goals that have comparison hypotheses over multiple types. This
creates multiple `linarith` problems, each of which is handled separately; the goal is solved as
soon as one problem is found to be contradictory.

Disequality hypotheses `t ≠ 0` do not fit in this pattern. `linarith` will attempt to prove equality
goals by splitting them into two weak inequalities and running twice. But it does not split
disequality hypotheses, since this would lead to a number of runs exponential in the number of
disequalities in the context.

The Fourier-Motzkin oracle is very modular. It can easily be replaced with another function of type
`certificate_oracle := list comp → ℕ → tactic (rb_map ℕ ℕ)`,
which takes a list of comparisons and the largest variable
index appearing in those comparisons, and returns a map from comparison indices to coefficients.
An alternate oracle can be specified in the `linarith_config` object.

A variant, `nlinarith`, adds an extra preprocessing step to handle some basic nonlinear goals.
There is a hook in the `linarith_config` configuration object to add custom preprocessing routines.

The certificate checking step is *not* by reflection. `linarith` converts the certificate into a
proof term of type `false`.

Some of the behavior of `linarith` can be inspected with the option
`set_option trace.linarith true`.
Because the variable elimination happens outside the tactic monad, we cannot trace intermediate
steps there.

## File structure

The components of `linarith` are spread between a number of files for the sake of organization.

* `lemmas.lean` contains proofs of some arithmetic lemmas that are used in preprocessing and in
  verification.
* `datatypes.lean` contains data structures that are used across multiple files, along with some
  useful auxiliary functions.
* `preprocessing.lean` contains functions used at the beginning of the tactic to transform
  hypotheses into a shape suitable for the main routine.
* `parsing.lean` contains functions used to compute the linear structure of an expression.
* `elimination.lean` contains the Fourier-Motzkin elimination routine.
* `verification.lean` contains the certificate checking functions that produce a proof of `false`.
* `frontend.lean` contains the control methods and user-facing components of the tactic.

## Tags

linarith, nlinarith, lra, nra, Fourier Motzkin, linear arithmetic, linear programming
-/

open tactic native

namespace linarith

/-! ### Control -/

/--
If `e` is a comparison `a R b` or the negation of a comparison `¬ a R b`, found in the target,
`get_contr_lemma_name_and_type e` returns the name of a lemma that will change the goal to an
implication, along with the type of `a` and `b`.

For example, if `e` is `(a : ℕ) < b`, returns ``(`lt_of_not_ge, ℕ)``.
-/
meta def get_contr_lemma_name_and_type : expr → option (name × expr)
| `(@has_lt.lt %%tp %%_ _ _) := return (`lt_of_not_ge, tp)
| `(@has_le.le %%tp %%_ _ _) := return (`le_of_not_gt, tp)
| `(@eq %%tp _ _) := return (``eq_of_not_lt_of_not_gt, tp)
| `(@ne %%tp _ _) := return (`not.intro, tp)
| `(@ge %%tp %%_ _ _) := return (`le_of_not_gt, tp)
| `(@gt %%tp %%_ _ _) := return (`lt_of_not_ge, tp)
| `(¬ @has_lt.lt %%tp %%_ _ _) := return (`not.intro, tp)
| `(¬ @has_le.le %%tp %%_ _ _) := return (`not.intro, tp)
| `(¬ @eq %%tp _ _) := return (``not.intro, tp)
| `(¬ @ge %%tp %%_ _ _) := return (`not.intro, tp)
| `(¬ @gt %%tp %%_ _ _) := return (`not.intro, tp)
| _ := none

/--
`apply_contr_lemma` inspects the target to see if it can be moved to a hypothesis by negation.
For example, a goal `⊢ a ≤ b` can become `a > b ⊢ false`.
If this is the case, it applies the appropriate lemma and introduces the new hypothesis.
It returns the type of the terms in the comparison (e.g. the type of `a` and `b` above) and the
newly introduced local constant.
Otherwise returns `none`.
-/
meta def apply_contr_lemma : tactic (option (expr × expr)) :=
do t ← target,
   match get_contr_lemma_name_and_type t with
   | some (nm, tp) :=
     do refine ((expr.const nm []) pexpr.mk_placeholder), v ← intro1, return $ some (tp, v)
   | none := return none
   end

/--
`partition_by_type l` takes a list `l` of proofs of comparisons. It sorts these proofs by
the type of the variables in the comparison, e.g. `(a : ℚ) < 1` and `(b : ℤ) > c` will be separated.
Returns a map from a type to a list of comparisons over that type.
-/
meta def partition_by_type (l : list expr) : tactic (rb_lmap expr expr) :=
l.mfoldl (λ m h, do tp ← ineq_prf_tp h, return $ m.insert tp h) mk_rb_map

/--
Given a list `ls` of lists of proofs of comparisons, `try_linarith_on_lists cfg ls` will try to
prove `false` by calling `linarith` on each list in succession. It will stop at the first proof of
`false`, and fail if no contradiction is found with any list.
-/
meta def try_linarith_on_lists (cfg : linarith_config) (ls : list (list expr)) : tactic expr :=
(first $ ls.map $ prove_false_by_linarith cfg) <|> fail "linarith failed to find a contradiction"

/--
Given a list `hyps` of proofs of comparisons, `run_linarith_on_pfs cfg hyps pref_type`
preprocesses `hyps` according to the list of preprocessors in `cfg`.
This results in a list of branches (typically only one),
each of which must succeed in order to close the goal.

In each branch, we partition the  list of hypotheses by type, and run `linarith` on each class
in the partition; one of these must succeed in order for `linarith` to succeed on this branch.
If `pref_type` is given, it will first use the class of proofs of comparisons over that type.
-/
meta def run_linarith_on_pfs (cfg : linarith_config) (hyps : list expr) (pref_type : option expr) :
  tactic unit :=
let single_process := λ hyps : list expr, do
   linarith_trace_proofs
     ("after preprocessing, linarith has " ++ to_string hyps.length ++ " facts:") hyps,
   hyp_set ← partition_by_type hyps,
   linarith_trace format!"hypotheses appear in {hyp_set.size} different types",
   match pref_type with
   | some t := prove_false_by_linarith cfg (hyp_set.ifind t) <|>
               try_linarith_on_lists cfg (rb_map.values (hyp_set.erase t))
   | none := try_linarith_on_lists cfg (rb_map.values hyp_set)
   end in
let preprocessors := cfg.preprocessors.get_or_else default_preprocessors,
    preprocessors := if cfg.split_ne then linarith.remove_ne::preprocessors else preprocessors in
do hyps ← preprocess preprocessors hyps,
hyps.mmap' $ λ hs, do set_goals [hs.1], single_process hs.2 >>= exact

/--
`filter_hyps_to_type restr_type hyps` takes a list of proofs of comparisons `hyps`, and filters it
to only those that are comparisons over the type `restr_type`.
-/
meta def filter_hyps_to_type (restr_type : expr) (hyps : list expr) : tactic (list expr) :=
hyps.mfilter $ λ h, do
  ht ← infer_type h,
  match get_contr_lemma_name_and_type ht with
  | some (_, htype) := succeeds $ unify htype restr_type
  | none := return ff
  end

/-- A hack to allow users to write `{restr_type := ℚ}` in configuration structures. -/
meta def get_restrict_type (e : expr) : tactic expr :=
do m ← mk_mvar,
   unify `(some %%m : option Type) e,
   instantiate_mvars m

end linarith

/-! ### User facing functions -/

open linarith

/--
`linarith reduce_semi only_on hyps cfg` tries to close the goal using linear arithmetic. It fails
if it does not succeed at doing this.

* If `reduce_semi` is true, it will unfold semireducible definitions when trying to match atomic
expressions.
* `hyps` is a list of proofs of comparisons to include in the search.
* If `only_on` is true, the search will be restricted to `hyps`. Otherwise it will use all
  comparisons in the local context.
-/
meta def tactic.linarith (reduce_semi : bool) (only_on : bool) (hyps : list pexpr)
  (cfg : linarith_config := {}) : tactic unit :=
focus1 $
do t ← target,
-- if the target is an equality, we run `linarith` twice, to prove ≤ and ≥.
if t.is_eq.is_some then
  linarith_trace "target is an equality: splitting" >>
    seq' (applyc ``eq_of_not_lt_of_not_gt) tactic.linarith else
do hyps ← hyps.mmap $ λ e, i_to_expr e >>= note_anon none,
   when cfg.split_hypotheses (linarith_trace "trying to split hypotheses" >> try auto.split_hyps),
/- If we are proving a comparison goal (and not just `false`), we consider the type of the
   elements in the comparison to be the "preferred" type. That is, if we find comparison
   hypotheses in multiple types, we will run `linarith` on the goal type first.
   In this case we also recieve a new variable from moving the goal to a hypothesis.
   Otherwise, there is no preferred type and no new variable; we simply change the goal to `false`.
-/
   pref_type_and_new_var_from_tgt ← apply_contr_lemma,
   when pref_type_and_new_var_from_tgt.is_none $
     if cfg.exfalso then linarith_trace "using exfalso" >> exfalso
     else fail "linarith failed: target is not a valid comparison",
   let cfg := cfg.update_reducibility reduce_semi,
   let (pref_type, new_var) :=
     pref_type_and_new_var_from_tgt.elim (none, none) (prod.map some some),
   -- set up the list of hypotheses, considering the `only_on` and `restrict_type` options
   hyps ← if only_on then return (new_var.elim [] singleton ++ hyps)
          else (++ hyps) <$> local_context,
   hyps ← (do t ← get_restrict_type cfg.restrict_type_reflect, filter_hyps_to_type t hyps) <|>
     return hyps,
   linarith_trace_proofs "linarith is running on the following hypotheses:" hyps,
   run_linarith_on_pfs cfg hyps pref_type

setup_tactic_parser

/--
Tries to prove a goal of `false` by linear arithmetic on hypotheses.
If the goal is a linear (in)equality, tries to prove it by contradiction.
If the goal is not `false` or an inequality, applies `exfalso` and tries linarith on the
hypotheses.

* `linarith` will use all relevant hypotheses in the local context.
* `linarith [t1, t2, t3]` will add proof terms t1, t2, t3 to the local context.
* `linarith only [h1, h2, h3, t1, t2, t3]` will use only the goal (if relevant), local hypotheses
  `h1`, `h2`, `h3`, and proofs `t1`, `t2`, `t3`. It will ignore the rest of the local context.
* `linarith!` will use a stronger reducibility setting to identify atoms.

Config options:
* `linarith {exfalso := ff}` will fail on a goal that is neither an inequality nor `false`
* `linarith {restrict_type := T}` will run only on hypotheses that are inequalities over `T`
* `linarith {discharger := tac}` will use `tac` instead of `ring` for normalization.
  Options: `ring2`, `ring SOP`, `simp`
* `linarith {split_hypotheses := ff}` will not destruct conjunctions in the context.
-/
meta def tactic.interactive.linarith (red : parse ((tk "!")?))
  (restr : parse ((tk "only")?)) (hyps : parse pexpr_list?)
  (cfg : linarith_config := {}) : tactic unit :=
tactic.linarith red.is_some restr.is_some (hyps.get_or_else []) cfg

add_hint_tactic "linarith"

/--
`linarith` attempts to find a contradiction between hypotheses that are linear (in)equalities.
Equivalently, it can prove a linear inequality by assuming its negation and proving `false`.

In theory, `linarith` should prove any goal that is true in the theory of linear arithmetic over
the rationals. While there is some special handling for non-dense orders like `nat` and `int`,
this tactic is not complete for these theories and will not prove every true goal. It will solve
goals over arbitrary types that instantiate `linear_ordered_comm_ring`.

An example:
```lean
example (x y z : ℚ) (h1 : 2*x  < 3*y) (h2 : -4*x + 2*z < 0)
        (h3 : 12*y - 4* z < 0)  : false :=
by linarith
```

`linarith` will use all appropriate hypotheses and the negation of the goal, if applicable.

`linarith [t1, t2, t3]` will additionally use proof terms `t1, t2, t3`.

`linarith only [h1, h2, h3, t1, t2, t3]` will use only the goal (if relevant), local hypotheses
`h1`, `h2`, `h3`, and proofs `t1`, `t2`, `t3`. It will ignore the rest of the local context.

`linarith!` will use a stronger reducibility setting to try to identify atoms. For example,
```lean
example (x : ℚ) : id x ≥ x :=
by linarith
```
will fail, because `linarith` will not identify `x` and `id x`. `linarith!` will.
This can sometimes be expensive.

`linarith {discharger := tac, restrict_type := tp, exfalso := ff}` takes a config object with five
optional arguments:
* `discharger` specifies a tactic to be used for reducing an algebraic equation in the
  proof stage. The default is `ring`. Other options currently include `ring SOP` or `simp` for basic
  problems.
* `restrict_type` will only use hypotheses that are inequalities over `tp`. This is useful
  if you have e.g. both integer and rational valued inequalities in the local context, which can
  sometimes confuse the tactic.
* `transparency` controls how hard `linarith` will try to match atoms to each other. By default
  it will only unfold `reducible` definitions.
* If `split_hypotheses` is true, `linarith` will split conjunctions in the context into separate
  hypotheses.
* If `exfalso` is false, `linarith` will fail when the goal is neither an inequality nor `false`.
  (True by default.)

A variant, `nlinarith`, does some basic preprocessing to handle some nonlinear goals.

The option `set_option trace.linarith true` will trace certain intermediate stages of the `linarith`
routine.
-/
add_tactic_doc
{ name       := "linarith",
  category   := doc_category.tactic,
  decl_names := [`tactic.interactive.linarith],
  tags       := ["arithmetic", "decision procedure", "finishing"] }

/--
An extension of `linarith` with some preprocessing to allow it to solve some nonlinear arithmetic
problems. (Based on Coq's `nra` tactic.) See `linarith` for the available syntax of options,
which are inherited by `nlinarith`; that is, `nlinarith!` and `nlinarith only [h1, h2]` all work as
in `linarith`. The preprocessing is as follows:

* For every subterm `a ^ 2` or `a * a` in a hypothesis or the goal,
  the assumption `0 ≤ a ^ 2` or `0 ≤ a * a` is added to the context.
* For every pair of hypotheses `a1 R1 b1`, `a2 R2 b2` in the context, `R1, R2 ∈ {<, ≤, =}`,
  the assumption `0 R' (b1 - a1) * (b2 - a2)` is added to the context (non-recursively),
  where `R ∈ {<, ≤, =}` is the appropriate comparison derived from `R1, R2`.
-/
meta def tactic.interactive.nlinarith (red : parse ((tk "!")?))
  (restr : parse ((tk "only")?)) (hyps : parse pexpr_list?)
  (cfg : linarith_config := {}) : tactic unit :=
tactic.linarith red.is_some restr.is_some (hyps.get_or_else [])
  { cfg with preprocessors := some $
      cfg.preprocessors.get_or_else default_preprocessors ++ [nlinarith_extras] }

add_hint_tactic "nlinarith"

add_tactic_doc
{ name       := "nlinarith",
  category   := doc_category.tactic,
  decl_names := [`tactic.interactive.nlinarith],
  tags       := ["arithmetic", "decision procedure", "finishing"] }


-- Suma_de_progresion_geometrica.lean
-- Suma de progresión geométrica
-- José A. Alonso Jiménez
-- Sevilla, 20 de septiembre de 2021
-- ---------------------------------------------------------------------

-- ---------------------------------------------------------------------
-- Demostrar que la suma de los términos de la progresión geomética
--    a + aq + aq² + ··· + aqⁿ
-- es
--      a(1 - qⁿ⁺¹)
--    --------------
--        1 - q
-- ---------------------------------------------------------------------

import data.real.basic
open nat

variable  (n : ℕ)
variables (a q : ℝ)

set_option pp.structure_projections false

@[simp]
def sumaPG : ℝ → ℝ → ℕ → ℝ
| a q 0       := a
| a q (n + 1) := sumaPG a q n + (a * q^(n + 1))

example :
  (1 - q) * sumaPG a q n = a * (1 - q^(n + 1)) :=
begin
  induction n with n HI,
  { simp,
    ac_refl, },
  { calc (1 - q) * sumaPG a q (succ n)
         = (1 - q) * (sumaPG a q n + (a * q^(n + 1)))
           : rfl
     ... = (1 - q) * sumaPG a q n + (1 - q) * (a * q^(n + 1))
           : by ring_nf
     ... = a * (1 - q ^ (n + 1)) + (1 - q) * (a * q^(n + 1))
           : by {congr ; rw HI}
     ... = a * (1 - q ^ (succ n + 1))
           : by ring_nf },
end


import data.real.basic
import tactic
open function real

namespace vilnius

/-- Composite of two injective functions is injective -/
theorem injective_comp (X Y Z : Type) (f : X → Y) (g : Y → Z)
  (hf : injective f) (hg : injective g) : injective (g ∘ f) :=
begin
  sorry,
end

/- ### The λ notation:
In Lean (or in Type Theory, rather) the way to define a function is to use λ expressions: here, you should think that `λ = ∀`: so, the function
`λ x, 3*x ^ 2 + 1`
is nothing else that the function
`f(x)=3*x ^ 2 + 1` or `f : x ↦ 3*x ^ 2 + 1`.

As for usual functions, the name of the variable does not matter, so
`λ x, 3*x ^ 2 + 1` is the same as `λ w, 3*w ^ 2 + 1`

The tactic to get rid of a `λ` term is
* `simp only` (possibly: at h)
because it "evaluates a λ-term", transforming, for instance
`(λ x, 2 * x + 1) 3` into `2 * 3 + 1`.
-/

theorem injective_id (X : Type) : injective (λ x : X, x) :=
begin
  sorry,
end

definition is_linear (f : ℝ → ℝ) : Prop := ∀ c x y, f (c * x + y) = c * f (x) + f(y)

/-- ## The tactics have and rewrite (rw)
* have (h) : It allows to introduce a claim, called h. After, you need to prove it. This states the (to be proven) existence of a term whose type is the RHS.
There exists also
* have (h) := This gives the name h to the term on the right.
-/

theorem linear_at_0 (f : ℝ → ℝ) (H : is_linear f) : f 0 = 0 :=
begin
  sorry,
end

/-- The tactic
* `use a` specializes an existential quantifier at x
* `ext`: the "extensionality rule": two functions f,  g are equal if and only if for all x, f x = g x
-/

theorem linear_explicit (f : ℝ → ℝ) (H : is_linear f) : ∃ a, f = λ x, a * x :=
begin
  sorry,
end

definition is_affine (f : ℝ → ℝ) : Prop := ∃ a, ∀ x y, f (y) - f(x) = a * (y - x)

theorem linear_add_cnst_of_affine (f : ℝ → ℝ) : is_affine f → (∃ a : ℝ, ∃ g : ℝ → ℝ, (f = g + (λ x, a)) ∧ is_linear g) :=
begin
  sorry,
end

theorem affine_of_linear_add_cnst (f : ℝ → ℝ) : (∃ b : ℝ, ∃ g : ℝ → ℝ,
  (f = g + (λ x, b)) ∧ is_linear g) → is_affine f :=
begin
 sorry,
end

end vilnius


/-
Copyright (c) 2016 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad
-/
import data.list.perm
import data.list.chain

/-!
# Sorting algorithms on lists

In this file we define `list.sorted r l` to be an alias for `pairwise r l`. This alias is preferred
in the case that `r` is a `<` or `≤`-like relation. Then we define two sorting algorithms:
`list.insertion_sort` and `list.merge_sort`, and prove their correctness.
-/

open list.perm

namespace list

/-!
### The predicate `list.sorted`
-/

section sorted
universe variable uu
variables {α : Type uu} {r : α → α → Prop}

/-- `sorted r l` is the same as `pairwise r l`, preferred in the case that `r`
  is a `<` or `≤`-like relation (transitive and antisymmetric or asymmetric) -/
def sorted := @pairwise

instance decidable_sorted [decidable_rel r] (l : list α) : decidable (sorted r l) :=
list.decidable_pairwise _

@[simp] theorem sorted_nil : sorted r [] := pairwise.nil

theorem sorted_of_sorted_cons {a : α} {l : list α} : sorted r (a :: l) → sorted r l :=
pairwise_of_pairwise_cons

theorem sorted.tail {r : α → α → Prop} {l : list α} (h : sorted r l) : sorted r l.tail :=
h.tail

theorem rel_of_sorted_cons {a : α} {l : list α} : sorted r (a :: l) →
  ∀ b ∈ l, r a b :=
rel_of_pairwise_cons

@[simp] theorem sorted_cons {a : α} {l : list α} :
  sorted r (a :: l) ↔ (∀ b ∈ l, r a b) ∧ sorted r l :=
pairwise_cons

protected theorem sorted.nodup {r : α → α → Prop} [is_irrefl α r] {l : list α} (h : sorted r l) :
  nodup l :=
h.nodup

theorem eq_of_perm_of_sorted [is_antisymm α r]
  {l₁ l₂ : list α} (p : l₁ ~ l₂) (s₁ : sorted r l₁) (s₂ : sorted r l₂) : l₁ = l₂ :=
begin
  induction s₁ with a l₁ h₁ s₁ IH generalizing l₂,
  { exact p.nil_eq },
  { have : a ∈ l₂ := p.subset (mem_cons_self _ _),
    rcases mem_split this with ⟨u₂, v₂, rfl⟩,
    have p' := (perm_cons a).1 (p.trans perm_middle),
    have := IH p' (pairwise_of_sublist (by simp) s₂), subst l₁,
    change a::u₂ ++ v₂ = u₂ ++ ([a] ++ v₂), rw ← append_assoc, congr,
    have : ∀ (x : α) (h : x ∈ u₂), x = a := λ x m,
      antisymm ((pairwise_append.1 s₂).2.2 _ m a (mem_cons_self _ _))
        (h₁ _ (by simp [m])),
    rw [(@eq_repeat _ a (length u₂ + 1) (a::u₂)).2,
        (@eq_repeat _ a (length u₂ + 1) (u₂++[a])).2];
    split; simp [iff_true_intro this, or_comm] }
end

@[simp] theorem sorted_singleton (a : α) : sorted r [a] := pairwise_singleton _ _

lemma sorted.rel_nth_le_of_lt {l : list α}
  (h : l.sorted r) {a b : ℕ} (ha : a < l.length) (hb : b < l.length) (hab : a < b) :
  r (l.nth_le a ha) (l.nth_le b hb) :=
list.pairwise_iff_nth_le.1 h a b hb hab

lemma sorted.rel_nth_le_of_le [is_refl α r] {l : list α}
  (h : l.sorted r) {a b : ℕ} (ha : a < l.length) (hb : b < l.length) (hab : a ≤ b) :
  r (l.nth_le a ha) (l.nth_le b hb) :=
begin
  cases eq_or_lt_of_le hab with H H,
  { subst H, exact refl _ },
  { exact h.rel_nth_le_of_lt _ _ H }
end

lemma sorted.rel_of_mem_take_of_mem_drop {l : list α} (h : list.sorted r l)
  {k : ℕ} {x y : α} (hx : x ∈ list.take k l) (hy : y ∈ list.drop k l) :
  r x y :=
begin
  obtain ⟨iy, hiy, rfl⟩ := nth_le_of_mem hy,
  obtain ⟨ix, hix, rfl⟩ := nth_le_of_mem hx,
  rw [nth_le_take', nth_le_drop'],
  rw length_take at hix,
  exact h.rel_nth_le_of_lt _ _ (ix.lt_add_right _ _ (lt_min_iff.mp hix).left)
end

end sorted

section sort
universe variable uu
variables {α : Type uu} (r : α → α → Prop) [decidable_rel r]
local infix ` ≼ ` : 50 := r

/-! ### Insertion sort -/

section insertion_sort

/-- `ordered_insert a l` inserts `a` into `l` at such that
  `ordered_insert a l` is sorted if `l` is. -/
@[simp] def ordered_insert (a : α) : list α → list α
| []       := [a]
| (b :: l) := if a ≼ b then a :: b :: l else b :: ordered_insert l

/-- `insertion_sort l` returns `l` sorted using the insertion sort algorithm. -/
@[simp] def insertion_sort : list α → list α
| []       := []
| (b :: l) := ordered_insert r b (insertion_sort l)

@[simp] lemma ordered_insert_nil (a : α) : [].ordered_insert r a = [a] := rfl

theorem ordered_insert_length : Π (L : list α) (a : α), (L.ordered_insert r a).length = L.length + 1
| [] a := rfl
| (hd :: tl) a := by { dsimp [ordered_insert], split_ifs; simp [ordered_insert_length], }

/-- An alternative definition of `ordered_insert` using `take_while` and `drop_while`. -/
lemma ordered_insert_eq_take_drop (a : α) : ∀ l : list α,
  l.ordered_insert r a = l.take_while (λ b, ¬(a ≼ b)) ++ (a :: l.drop_while (λ b, ¬(a ≼ b)))
| [] := rfl
| (b :: l) := by { dsimp only [ordered_insert], split_ifs; simp [take_while, drop_while, *] }

lemma insertion_sort_cons_eq_take_drop (a : α) (l : list α) :
  insertion_sort r (a :: l) = (insertion_sort r l).take_while (λ b, ¬(a ≼ b)) ++
    (a :: (insertion_sort r l).drop_while (λ b, ¬(a ≼ b))) :=
ordered_insert_eq_take_drop r a _

section correctness
open perm

theorem perm_ordered_insert (a) : ∀ l : list α, ordered_insert r a l ~ a :: l
| []       := perm.refl _
| (b :: l) := by by_cases a ≼ b; [simp [ordered_insert, h],
  simpa [ordered_insert, h] using
    ((perm_ordered_insert l).cons _).trans (perm.swap _ _ _)]

theorem ordered_insert_count [decidable_eq α] (L : list α) (a b : α) :
  count a (L.ordered_insert r b) = count a L + if (a = b) then 1 else 0 :=
begin
  rw [(L.perm_ordered_insert r b).count_eq, count_cons],
  split_ifs; simp only [nat.succ_eq_add_one, add_zero],
end

theorem perm_insertion_sort : ∀ l : list α, insertion_sort r l ~ l
| []       := perm.nil
| (b :: l) := by simpa [insertion_sort] using
  (perm_ordered_insert _ _ _).trans ((perm_insertion_sort l).cons b)

variable {r}

/-- If `l` is already `list.sorted` with respect to `r`, then `insertion_sort` does not change
it. -/
lemma sorted.insertion_sort_eq : ∀ {l : list α} (h : sorted r l), insertion_sort r l = l
| [] _ := rfl
| [a] _ := rfl
| (a :: b :: l) h :=
  begin
    rw [insertion_sort, sorted.insertion_sort_eq, ordered_insert, if_pos],
    exacts [rel_of_sorted_cons h _ (or.inl rfl), h.tail]
  end

section total_and_transitive
variables [is_total α r] [is_trans α r]

theorem sorted.ordered_insert (a : α) : ∀ l, sorted r l → sorted r (ordered_insert r a l)
| []       h := sorted_singleton a
| (b :: l) h := begin
  by_cases h' : a ≼ b,
  { simpa [ordered_insert, h', h] using λ b' bm, trans h' (rel_of_sorted_cons h _ bm) },
  { suffices : ∀ (b' : α), b' ∈ ordered_insert r a l → r b b',
    { simpa [ordered_insert, h', (sorted_of_sorted_cons h).ordered_insert l] },
    intros b' bm,
    cases (show b' = a ∨ b' ∈ l, by simpa using
      (perm_ordered_insert _ _ _).subset bm) with be bm,
    { subst b', exact (total_of r _ _).resolve_left h' },
    { exact rel_of_sorted_cons h _ bm } }
end

variable (r)

/-- The list `list.insertion_sort r l` is `list.sorted` with respect to `r`. -/
theorem sorted_insertion_sort : ∀ l, sorted r (insertion_sort r l)
| []       := sorted_nil
| (a :: l) := (sorted_insertion_sort l).ordered_insert a _

end total_and_transitive
end correctness
end insertion_sort

/-! ### Merge sort -/

section merge_sort

-- TODO(Jeremy): observation: if instead we write (a :: (split l).1, b :: (split l).2), the
-- equation compiler can't prove the third equation

/-- Split `l` into two lists of approximately equal length.

     split [1, 2, 3, 4, 5] = ([1, 3, 5], [2, 4]) -/
@[simp] def split : list α → list α × list α
| []       := ([], [])
| (a :: l) := let (l₁, l₂) := split l in (a :: l₂, l₁)

theorem split_cons_of_eq (a : α) {l l₁ l₂ : list α} (h : split l = (l₁, l₂)) :
  split (a :: l) = (a :: l₂, l₁) :=
by rw [split, h]; refl

theorem length_split_le : ∀ {l l₁ l₂ : list α},
  split l = (l₁, l₂) → length l₁ ≤ length l ∧ length l₂ ≤ length l
| []     ._  ._  rfl := ⟨nat.le_refl 0, nat.le_refl 0⟩
| (a::l) l₁' l₂' h   := begin
  cases e : split l with l₁ l₂,
  injection (split_cons_of_eq _ e).symm.trans h, substs l₁' l₂',
  cases length_split_le e with h₁ h₂,
  exact ⟨nat.succ_le_succ h₂, nat.le_succ_of_le h₁⟩
end

theorem length_split_lt {a b} {l l₁ l₂ : list α} (h : split (a::b::l) = (l₁, l₂)) :
  length l₁ < length (a::b::l) ∧ length l₂ < length (a::b::l) :=
begin
  cases e : split l with l₁' l₂',
  injection (split_cons_of_eq _ (split_cons_of_eq _ e)).symm.trans h, substs l₁ l₂,
  cases length_split_le e with h₁ h₂,
  exact ⟨nat.succ_le_succ (nat.succ_le_succ h₁), nat.succ_le_succ (nat.succ_le_succ h₂)⟩
end

theorem perm_split : ∀ {l l₁ l₂ : list α}, split l = (l₁, l₂) → l ~ l₁ ++ l₂
| []     ._  ._  rfl := perm.refl _
| (a::l) l₁' l₂' h   := begin
  cases e : split l with l₁ l₂,
  injection (split_cons_of_eq _ e).symm.trans h, substs l₁' l₂',
  exact ((perm_split e).trans perm_append_comm).cons a,
end

/-- Merge two sorted lists into one in linear time.

     merge [1, 2, 4, 5] [0, 1, 3, 4] = [0, 1, 1, 2, 3, 4, 4, 5] -/
def merge : list α → list α → list α
| []       l'        := l'
| l        []        := l
| (a :: l) (b :: l') := if a ≼ b then a :: merge l (b :: l') else b :: merge (a :: l) l'

include r
/-- Implementation of a merge sort algorithm to sort a list. -/
def merge_sort : list α → list α
| []        := []
| [a]       := [a]
| (a::b::l) := begin
  cases e : split (a::b::l) with l₁ l₂,
  cases length_split_lt e with h₁ h₂,
  exact merge r (merge_sort l₁) (merge_sort l₂)
end
using_well_founded {
  rel_tac := λ_ _, `[exact ⟨_, inv_image.wf length nat.lt_wf⟩],
  dec_tac := tactic.assumption }

theorem merge_sort_cons_cons {a b} {l l₁ l₂ : list α}
  (h : split (a::b::l) = (l₁, l₂)) :
  merge_sort r (a::b::l) = merge r (merge_sort r l₁) (merge_sort r l₂) :=
begin
  suffices : ∀ (L : list α) h1, @@and.rec
    (λ a a (_ : length l₁ < length l + 1 + 1 ∧
      length l₂ < length l + 1 + 1), L) h1 h1 = L,
  { simp [merge_sort, h], apply this },
  intros, cases h1, refl
end

section correctness

theorem perm_merge : ∀ (l l' : list α), merge r l l' ~ l ++ l'
| []       []        := by simp [merge]
| []       (b :: l') := by simp [merge]
| (a :: l) []        := by simp [merge]
| (a :: l) (b :: l') := begin
  by_cases a ≼ b,
  { simpa [merge, h] using perm_merge _ _ },
  { suffices : b :: merge r (a :: l) l' ~ a :: (l ++ b :: l'), {simpa [merge, h]},
    exact ((perm_merge _ _).cons _).trans ((swap _ _ _).trans (perm_middle.symm.cons _)) }
end

theorem perm_merge_sort : ∀ l : list α, merge_sort r l ~ l
| []        := by simp [merge_sort]
| [a]       := by simp [merge_sort]
| (a::b::l) := begin
  cases e : split (a::b::l) with l₁ l₂,
  cases length_split_lt e with h₁ h₂,
  rw [merge_sort_cons_cons r e],
  apply (perm_merge r _ _).trans,
  exact ((perm_merge_sort l₁).append (perm_merge_sort l₂)).trans (perm_split e).symm
end
using_well_founded {
  rel_tac := λ_ _, `[exact ⟨_, inv_image.wf length nat.lt_wf⟩],
  dec_tac := tactic.assumption }

@[simp] lemma length_merge_sort (l : list α) : (merge_sort r l).length = l.length :=
(perm_merge_sort r _).length_eq

section total_and_transitive
variables {r} [is_total α r] [is_trans α r]

theorem sorted.merge : ∀ {l l' : list α}, sorted r l → sorted r l' → sorted r (merge r l l')
| []       []        h₁ h₂ := by simp [merge]
| []       (b :: l') h₁ h₂ := by simpa [merge] using h₂
| (a :: l) []        h₁ h₂ := by simpa [merge] using h₁
| (a :: l) (b :: l') h₁ h₂ := begin
  by_cases a ≼ b,
  { suffices : ∀ (b' : α) (_ : b' ∈ merge r l (b :: l')), r a b',
    { simpa [merge, h, (sorted_of_sorted_cons h₁).merge h₂] },
    intros b' bm,
    rcases (show b' = b ∨ b' ∈ l ∨ b' ∈ l', by simpa [or.left_comm] using
      (perm_merge _ _ _).subset bm) with be | bl | bl',
    { subst b', assumption },
    { exact rel_of_sorted_cons h₁ _ bl },
    { exact trans h (rel_of_sorted_cons h₂ _ bl') } },
  { suffices : ∀ (b' : α) (_ : b' ∈ merge r (a :: l) l'), r b b',
    { simpa [merge, h, h₁.merge (sorted_of_sorted_cons h₂)] },
    intros b' bm,
    have ba : b ≼ a := (total_of r _ _).resolve_left h,
    rcases (show b' = a ∨ b' ∈ l ∨ b' ∈ l', by simpa using
      (perm_merge _ _ _).subset bm) with be | bl | bl',
    { subst b', assumption },
    { exact trans ba (rel_of_sorted_cons h₁ _ bl) },
    { exact rel_of_sorted_cons h₂ _ bl' } }
end

variable (r)

theorem sorted_merge_sort : ∀ l : list α, sorted r (merge_sort r l)
| []        := by simp [merge_sort]
| [a]       := by simp [merge_sort]
| (a::b::l) := begin
  cases e : split (a::b::l) with l₁ l₂,
  cases length_split_lt e with h₁ h₂,
  rw [merge_sort_cons_cons r e],
  exact (sorted_merge_sort l₁).merge (sorted_merge_sort l₂)
end
using_well_founded {
  rel_tac := λ_ _, `[exact ⟨_, inv_image.wf length nat.lt_wf⟩],
  dec_tac := tactic.assumption }

theorem merge_sort_eq_self [is_antisymm α r] {l : list α} : sorted r l → merge_sort r l = l :=
eq_of_perm_of_sorted (perm_merge_sort _ _) (sorted_merge_sort _ _)

theorem merge_sort_eq_insertion_sort [is_antisymm α r] (l : list α) :
  merge_sort r l = insertion_sort r l :=
eq_of_perm_of_sorted ((perm_merge_sort r l).trans (perm_insertion_sort r l).symm)
  (sorted_merge_sort r l) (sorted_insertion_sort r l)

end total_and_transitive
end correctness
end merge_sort
end sort

/- try them out! -/

--#eval insertion_sort (λ m n : ℕ, m ≤ n) [5, 27, 221, 95, 17, 43, 7, 2, 98, 567, 23, 12]

--#eval merge_sort     (λ m n : ℕ, m ≤ n) [5, 27, 221, 95, 17, 43, 7, 2, 98, 567, 23, 12]

end list


/-
Copyright (c) 2021 Heather Macbeth. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Heather Macbeth, Yury Kudryashov
-/
import topology.algebra.ordered.basic

/-!
# Bounded monotone sequences converge

In this file we prove a few theorems of the form “if the range of a monotone function `f : ι → α`
admits a least upper bound `a`, then `f x` tends to `a` as `x → ∞`”, as well as version of this
statement for (conditionally) complete lattices that use `⨆ x, f x` instead of `is_lub`.

These theorems work for linear orders with order topologies as well as their products (both in terms
of `prod` and in terms of function types). In order to reduce code duplication, we introduce two
typeclasses (one for the property formulated above and one for the dual property), prove theorems
assuming one of these typeclasses, and provide instances for linear orders and their products.

We also prove some "inverse" results: if `f n` is a monotone sequence and `a` is its limit,
then `f n ≤ a` for all `n`.

## Tags

monotone convergence
-/

open filter set function
open_locale filter topological_space classical

variables {α β : Type*}

/-- We say that `α` is a `Sup_convergence_class` if the following holds. Let `f : ι → α` be a
monotone function, let `a : α` be a least upper bound of `set.range f`. Then `f x` tends to `𝓝 a` as
`x → ∞` (formally, at the filter `filter.at_top`). We require this for `ι = (s : set α)`, `f = coe`
in the definition, then prove it for any `f` in `tendsto_at_top_is_lub`.

This property holds for linear orders with order topology as well as their products. -/
class Sup_convergence_class (α : Type*) [preorder α] [topological_space α] : Prop :=
(tendsto_coe_at_top_is_lub : ∀ (a : α) (s : set α), is_lub s a → tendsto (coe : s → α) at_top (𝓝 a))

/-- We say that `α` is an `Inf_convergence_class` if the following holds. Let `f : ι → α` be a
monotone function, let `a : α` be a greatest lower bound of `set.range f`. Then `f x` tends to `𝓝 a`
as `x → -∞` (formally, at the filter `filter.at_bot`). We require this for `ι = (s : set α)`,
`f = coe` in the definition, then prove it for any `f` in `tendsto_at_bot_is_glb`.

This property holds for linear orders with order topology as well as their products. -/
class Inf_convergence_class (α : Type*) [preorder α] [topological_space α] : Prop :=
(tendsto_coe_at_bot_is_glb : ∀ (a : α) (s : set α), is_glb s a → tendsto (coe : s → α) at_bot (𝓝 a))

instance order_dual.Sup_convergence_class [preorder α] [topological_space α]
  [Inf_convergence_class α] : Sup_convergence_class (order_dual α) :=
⟨‹Inf_convergence_class α›.1⟩

instance order_dual.Inf_convergence_class [preorder α] [topological_space α]
  [Sup_convergence_class α] : Inf_convergence_class (order_dual α) :=
⟨‹Sup_convergence_class α›.1⟩

@[priority 100] -- see Note [lower instance priority]
instance linear_order.Sup_convergence_class [topological_space α] [linear_order α]
  [order_topology α] : Sup_convergence_class α :=
begin
  refine ⟨λ a s ha, tendsto_order.2 ⟨λ b hb, _, λ b hb, _⟩⟩,
  { rcases ha.exists_between hb with ⟨c, hcs, bc, bca⟩,
    lift c to s using hcs,
    refine (eventually_ge_at_top c).mono (λ x hx, bc.trans_le hx) },
  { exact eventually_of_forall (λ x, (ha.1 x.2).trans_lt hb) }
end

@[priority 100] -- see Note [lower instance priority]
instance linear_order.Inf_convergence_class [topological_space α] [linear_order α]
  [order_topology α] : Inf_convergence_class α :=
show Inf_convergence_class (order_dual $ order_dual α), from order_dual.Inf_convergence_class

section

variables {ι : Type*} [preorder ι] [topological_space α]

section is_lub

variables [preorder α] [Sup_convergence_class α] {f : ι → α} {a : α}

lemma tendsto_at_top_is_lub (h_mono : monotone f) (ha : is_lub (set.range f) a) :
  tendsto f at_top (𝓝 a) :=
begin
  suffices : tendsto (range_factorization f) at_top at_top,
    from (Sup_convergence_class.tendsto_coe_at_top_is_lub _ _ ha).comp this,
  exact h_mono.range_factorization.tendsto_at_top_at_top (λ b, b.2.imp $ λ a ha, ha.ge)
end

lemma tendsto_at_bot_is_lub (h_anti : antitone f)
  (ha : is_lub (set.range f) a) : tendsto f at_bot (𝓝 a) :=
@tendsto_at_top_is_lub α (order_dual ι) _ _ _ _ f a h_anti.dual ha

end is_lub

section is_glb

variables [preorder α] [Inf_convergence_class α] {f : ι → α} {a : α}

lemma tendsto_at_bot_is_glb (h_mono : monotone f) (ha : is_glb (set.range f) a) :
  tendsto f at_bot (𝓝 a) :=
@tendsto_at_top_is_lub (order_dual α) (order_dual ι) _ _ _ _ f a h_mono.dual ha

lemma tendsto_at_top_is_glb (h_anti : antitone f)
  (ha : is_glb (set.range f) a) :
  tendsto f at_top (𝓝 a) :=
@tendsto_at_top_is_lub (order_dual α) ι _ _ _ _ f a h_anti ha

end is_glb

section csupr

variables [conditionally_complete_lattice α] [Sup_convergence_class α] {f : ι → α} {a : α}

lemma tendsto_at_top_csupr (h_mono : monotone f) (hbdd : bdd_above $ range f) :
  tendsto f at_top (𝓝 (⨆i, f i)) :=
begin
  casesI is_empty_or_nonempty ι,
  exacts [tendsto_of_is_empty, tendsto_at_top_is_lub h_mono (is_lub_csupr hbdd)]
end

lemma tendsto_at_bot_csupr (h_anti : antitone f)
  (hbdd : bdd_above $ range f) :
  tendsto f at_bot (𝓝 (⨆i, f i)) :=
@tendsto_at_top_csupr α (order_dual ι) _ _ _ _ _ h_anti.dual hbdd

end csupr

section cinfi

variables [conditionally_complete_lattice α] [Inf_convergence_class α] {f : ι → α} {a : α}

lemma tendsto_at_bot_cinfi (h_mono : monotone f) (hbdd : bdd_below $ range f) :
  tendsto f at_bot (𝓝 (⨅i, f i)) :=
@tendsto_at_top_csupr (order_dual α) (order_dual ι) _ _ _ _ _ h_mono.dual hbdd

lemma tendsto_at_top_cinfi (h_anti : antitone f)
  (hbdd : bdd_below $ range f) :
  tendsto f at_top (𝓝 (⨅i, f i)) :=
@tendsto_at_top_csupr (order_dual α) ι _ _ _ _ _ h_anti hbdd

end cinfi

section supr

variables [complete_lattice α] [Sup_convergence_class α] {f : ι → α} {a : α}

lemma tendsto_at_top_supr (h_mono : monotone f) : tendsto f at_top (𝓝 (⨆i, f i)) :=
tendsto_at_top_csupr h_mono (order_top.bdd_above _)

lemma tendsto_at_bot_supr (h_anti : antitone f) :
  tendsto f at_bot (𝓝 (⨆i, f i)) :=
tendsto_at_bot_csupr h_anti (order_top.bdd_above _)

end supr

section infi

variables [complete_lattice α] [Inf_convergence_class α] {f : ι → α} {a : α}

lemma tendsto_at_bot_infi (h_mono : monotone f) : tendsto f at_bot (𝓝 (⨅i, f i)) :=
tendsto_at_bot_cinfi h_mono (order_bot.bdd_below _)

lemma tendsto_at_top_infi (h_anti : antitone f) :
  tendsto f at_top (𝓝 (⨅i, f i)) :=
tendsto_at_top_cinfi h_anti (order_bot.bdd_below _)

end infi

end

instance [preorder α] [preorder β] [topological_space α] [topological_space β]
  [Sup_convergence_class α] [Sup_convergence_class β] : Sup_convergence_class (α × β) :=
begin
  constructor,
  rintro ⟨a, b⟩ s h,
  rw [is_lub_prod, ← range_restrict, ← range_restrict] at h,
  have A : tendsto (λ x : s, (x : α × β).1) at_top (𝓝 a),
    from tendsto_at_top_is_lub (monotone_fst.restrict s) h.1,
  have B : tendsto (λ x : s, (x : α × β).2) at_top (𝓝 b),
    from tendsto_at_top_is_lub (monotone_snd.restrict s) h.2,
  convert A.prod_mk_nhds B,
  ext1 ⟨⟨x, y⟩, h⟩, refl
end

instance [preorder α] [preorder β] [topological_space α] [topological_space β]
  [Inf_convergence_class α] [Inf_convergence_class β] : Inf_convergence_class (α × β) :=
show Inf_convergence_class (order_dual $ (order_dual α × order_dual β)),
  from order_dual.Inf_convergence_class

instance {ι : Type*} {α : ι → Type*} [Π i, preorder (α i)] [Π i, topological_space (α i)]
  [Π i, Sup_convergence_class (α i)] : Sup_convergence_class (Π i, α i) :=
begin
  refine ⟨λ f s h, _⟩,
  simp only [is_lub_pi, ← range_restrict] at h,
  exact tendsto_pi_nhds.2 (λ i, tendsto_at_top_is_lub ((monotone_eval _).restrict _) (h i))
end

instance {ι : Type*} {α : ι → Type*} [Π i, preorder (α i)] [Π i, topological_space (α i)]
  [Π i, Inf_convergence_class (α i)] : Inf_convergence_class (Π i, α i) :=
show Inf_convergence_class (order_dual $ Π i, order_dual (α i)),
  from order_dual.Inf_convergence_class

instance pi.Sup_convergence_class' {ι : Type*} [preorder α] [topological_space α]
  [Sup_convergence_class α] : Sup_convergence_class (ι → α) :=
pi.Sup_convergence_class

instance pi.Inf_convergence_class' {ι : Type*} [preorder α] [topological_space α]
  [Inf_convergence_class α] : Inf_convergence_class (ι → α) :=
pi.Inf_convergence_class

lemma tendsto_of_monotone {ι α : Type*} [preorder ι] [topological_space α]
  [conditionally_complete_linear_order α] [order_topology α] {f : ι → α} (h_mono : monotone f) :
  tendsto f at_top at_top ∨ (∃ l, tendsto f at_top (𝓝 l)) :=
if H : bdd_above (range f) then or.inr ⟨_, tendsto_at_top_csupr h_mono H⟩
else or.inl $ tendsto_at_top_at_top_of_monotone' h_mono H

lemma tendsto_iff_tendsto_subseq_of_monotone {ι₁ ι₂ α : Type*} [semilattice_sup ι₁] [preorder ι₂]
  [nonempty ι₁] [topological_space α] [conditionally_complete_linear_order α] [order_topology α]
  [no_top_order α] {f : ι₂ → α} {φ : ι₁ → ι₂} {l : α} (hf : monotone f)
  (hg : tendsto φ at_top at_top) :
  tendsto f at_top (𝓝 l) ↔ tendsto (f ∘ φ) at_top (𝓝 l) :=
begin
  split; intro h,
  { exact h.comp hg },
  { rcases tendsto_of_monotone hf with h' | ⟨l', hl'⟩,
    { exact (not_tendsto_at_top_of_tendsto_nhds h (h'.comp hg)).elim },
    { rwa tendsto_nhds_unique h (hl'.comp hg) } }
end

/-! The next family of results, such as `is_lub_of_tendsto` and `supr_eq_of_tendsto`, are converses
to the standard fact that bounded monotone functions converge. They state, that if a monotone
function `f` tends to `a` along `at_top`, then that value `a` is a least upper bound for the range
of `f`.

Related theorems above (`is_lub.is_lub_of_tendsto`, `is_glb.is_glb_of_tendsto` etc) cover the case
when `f x` tends to `a` as `x` tends to some point `b` in the domain. -/

lemma monotone.ge_of_tendsto {α β : Type*} [topological_space α] [preorder α]
  [order_closed_topology α] [semilattice_sup β] {f : β → α} {a : α} (hf : monotone f)
  (ha : tendsto f at_top (𝓝 a)) (b : β) :
  f b ≤ a :=
begin
  haveI : nonempty β := nonempty.intro b,
  exact ge_of_tendsto ha ((eventually_ge_at_top b).mono (λ _ hxy, hf hxy))
end

lemma monotone.le_of_tendsto {α β : Type*} [topological_space α] [preorder α]
  [order_closed_topology α] [semilattice_inf β] {f : β → α} {a : α} (hf : monotone f)
  (ha : tendsto f at_bot (𝓝 a)) (b : β) :
  a ≤ f b :=
@monotone.ge_of_tendsto (order_dual α) (order_dual β) _ _ _ _ f _ hf.dual ha b

lemma is_lub_of_tendsto {α β : Type*} [topological_space α] [preorder α] [order_closed_topology α]
  [nonempty β] [semilattice_sup β] {f : β → α} {a : α} (hf : monotone f)
  (ha : tendsto f at_top (𝓝 a)) :
  is_lub (set.range f) a :=
begin
  split,
  { rintros _ ⟨b, rfl⟩,
    exact hf.ge_of_tendsto ha b },
  { exact λ _ hb, le_of_tendsto' ha (λ x, hb (set.mem_range_self x)) }
end

lemma is_glb_of_tendsto {α β : Type*} [topological_space α] [preorder α] [order_closed_topology α]
  [nonempty β] [semilattice_inf β] {f : β → α} {a : α} (hf : monotone f)
  (ha : tendsto f at_bot (𝓝 a)) :
  is_glb (set.range f) a :=
@is_lub_of_tendsto (order_dual α) (order_dual β) _ _ _ _ _ _ _ hf.dual ha

lemma supr_eq_of_tendsto {α β} [topological_space α] [complete_linear_order α] [order_topology α]
  [nonempty β] [semilattice_sup β] {f : β → α} {a : α} (hf : monotone f) :
  tendsto f at_top (𝓝 a) → supr f = a :=
tendsto_nhds_unique (tendsto_at_top_supr hf)

lemma infi_eq_of_tendsto {α} [topological_space α] [complete_linear_order α] [order_topology α]
  [nonempty β] [semilattice_sup β] {f : β → α} {a : α} (hf : antitone f) :
  tendsto f at_top (𝓝 a) → infi f = a :=
tendsto_nhds_unique (tendsto_at_top_infi hf)

lemma supr_eq_supr_subseq_of_monotone {ι₁ ι₂ α : Type*} [preorder ι₂] [complete_lattice α]
  {l : filter ι₁} [l.ne_bot] {f : ι₂ → α} {φ : ι₁ → ι₂} (hf : monotone f)
  (hφ : tendsto φ l at_top) :
  (⨆ i, f i) = (⨆ i, f (φ i)) :=
le_antisymm
  (supr_le_supr2 $ λ i, exists_imp_exists (λ j (hj : i ≤ φ j), hf hj)
    (hφ.eventually $ eventually_ge_at_top i).exists)
  (supr_le_supr2 $ λ i, ⟨φ i, le_refl _⟩)

lemma infi_eq_infi_subseq_of_monotone {ι₁ ι₂ α : Type*} [preorder ι₂] [complete_lattice α]
  {l : filter ι₁} [l.ne_bot] {f : ι₂ → α} {φ : ι₁ → ι₂} (hf : monotone f)
  (hφ : tendsto φ l at_bot) :
  (⨅ i, f i) = (⨅ i, f (φ i)) :=
supr_eq_supr_subseq_of_monotone hf.dual hφ


/-
Copyright (c) 2021 Kevin Buzzard. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author : Kevin Buzzard
-/

import tactic -- imports all the Lean tactics

/-!

# Sets in Lean, example sheet 1 : "forall" (`∀`)

A lot of questions about sets can be reduced to questions about logic.
We explain how to do this in Lean.

All the sets we consider on this and the next few sheets will all be
subsets of an underlying set `X`, which is our "universe" where all
the maths we do will take place. This underlying set `X` is called a "type" in
Lean. It plays the role of a "universe" -- every element we consider will
always be an element of `X`, and every subset we consider will
be a subset of `X`.

Notation: elements of `X` are called *terms* of the type `X` and the
notation is `x : X`. All the variables `x`, `y` and `z` which appear in this
sheet will always be terms of type `X`, i.e. elements of the set `X`
if you want to think set-theoretically.

All the sets `A`, `B`, `C` etc we consider will be subsets of `X`.
If `x : X` then `x` may or may not be an element of `A`, `B`, `C`,
but it will always be an element of `X`.

## Tactics

Tactics you will need to know for this sheet:

* `intro` (it works for `∀` goals as well as for `P → Q`)
* `specialize`

### The `intro` tactic

If the goal is `∀ x, P(x)` then `intro a,` lets `a` be an arbitrary
element of `X` (or, more precisely, an arbitrary term of type `X`)
and changes the goal to `P(a)`.

### The `specialize` tactic

If we have a hypothesis `h : ∀ x, P(x)` and we have a term `a : X`
then `specialize h a,` changes `h` to `h : P(a)`.

-/

-- set up variables
variables
  (X : Type) -- Everything will be a subset of `X`
  (A B C D E : set X) -- A,B,C,D,E are subsets of `X`
  (x y z : X) -- x,y,z are elements of `X` or, more precisely, terms of type `X`

-- You can start this one with `intro x`
example : ∀ x : X, x ∈ A → x ∈ A :=
begin
  sorry,
end

example : ∀ x : X, (x ∈ A ∧ x ∈ B) → x ∈ A :=
begin
  sorry
end

-- for this one if you start with `intros h x` then you might well
-- need `specialize h x` later on. This is how to use hypotheses with `∀` in.
example : (∀ x, x ∈ A ∧ x ∈ B) → (∀ x, x ∈ A) :=
begin
  sorry
end

example : (∀ x, x ∈ A ∧ x ∈ B) → (∀ y, y ∈ B ∧ y ∈ A) :=
begin
  sorry
end

example : (∀ x, x ∈ A → x ∈ B) → (∀ y, y ∈ B → y ∈ C) →
  (∀ z, z ∈ A → z ∈ C) :=
begin
  sorry
end