/-
Copyright (c) 2018 Kevin Buzzard, Patrick Massot. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kevin Buzzard, Patrick Massot

This file is to a certain extent based on `quotient_module.lean` by Johannes Hölzl.

! This file was ported from Lean 3 source module group_theory.quotient_group
! leanprover-community/mathlib commit 59694bd07f0a39c5beccba34bd9f413a160782bf
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.GroupTheory.Congruence
import Mathlib.GroupTheory.Coset
import Mathlib.GroupTheory.Subgroup.Finite
import Mathlib.GroupTheory.Subgroup.Pointwise

/-!
# Quotients of groups by normal subgroups

This files develops the basic theory of quotients of groups by normal subgroups. In particular it
proves Noether's first and second isomorphism theorems.

## Main definitions

* `mk'`: the canonical group homomorphism `G →* G/N` given a normal subgroup `N` of `G`.
* `lift φ`: the group homomorphism `G/N →* H` given a group homomorphism `φ : G →* H` such that
  `N ⊆ ker φ`.
* `map f`: the group homomorphism `G/N →* H/M` given a group homomorphism `f : G →* H` such that
  `N ⊆ f⁻¹(M)`.

## Main statements

* `QuotientGroup.quotientKerEquivRange`: Noether's first isomorphism theorem, an explicit
  isomorphism `G/ker φ → range φ` for every group homomorphism `φ : G →* H`.
* `QuotientGroup.quotientInfEquivProdNormalQuotient`: Noether's second isomorphism theorem, an
  explicit isomorphism between `H/(H ∩ N)` and `(HN)/N` given a subgroup `H` and a normal subgroup
  `N` of a group `G`.
* `QuotientGroup.quotientQuotientEquivQuotient`: Noether's third isomorphism theorem,
  the canonical isomorphism between `(G / N) / (M / N)` and `G / M`, where `N ≤ M`.

## Tags

isomorphism theorems, quotient groups
-/

open Function

universe u v

namespace QuotientGroup

variable {G : Type u} [Group G] (N : Subgroup G) [nN : N.Normal] {H : Type v} [Group H]

/-- The congruence relation generated by a normal subgroup. -/
@[to_additive "The additive congruence relation generated by a normal additive subgroup."]
protected def con : Con G where
  toSetoid := leftRel N
  mul' := @fun a b c d hab hcd => by
    rw [leftRel_eq] at hab hcd ⊢
    dsimp only
    calc
      (a * c)⁻¹ * (b * d) = c⁻¹ * (a⁻¹ * b) * c⁻¹⁻¹ * (c⁻¹ * d) :=
        by simp only [mul_inv_rev, mul_assoc, inv_mul_cancel_left]
      _ ∈ N := N.mul_mem (nN.conj_mem _ hab _) hcd

#align quotient_group.con QuotientGroup.con
#align quotient_add_group.con QuotientAddGroup.con

@[to_additive]
instance Quotient.group : Group (G ⧸ N) :=
  (QuotientGroup.con N).group
#align quotient_group.quotient.group QuotientGroup.Quotient.group
#align quotient_add_group.quotient.add_group QuotientAddGroup.Quotient.addGroup

/-- The group homomorphism from `G` to `G/N`. -/
@[to_additive "The additive group homomorphism from `G` to `G/N`."]
def mk' : G →* G ⧸ N :=
  MonoidHom.mk' QuotientGroup.mk fun _ _ => rfl
#align quotient_group.mk' QuotientGroup.mk'
#align quotient_add_group.mk' QuotientAddGroup.mk'

@[to_additive (attr := simp)]
theorem coe_mk' : (mk' N : G → G ⧸ N) = mk :=
  rfl
#align quotient_group.coe_mk' QuotientGroup.coe_mk'
#align quotient_add_group.coe_mk' QuotientAddGroup.coe_mk'

@[to_additive (attr := simp)]

@[to_additive]
theorem mk'_surjective : Surjective <| mk' N :=
  @mk_surjective _ _ N
#align quotient_group.mk'_surjective QuotientGroup.mk'_surjective
#align quotient_add_group.mk'_surjective QuotientAddGroup.mk'_surjective

@[to_additive]
theorem mk'_eq_mk' {x y : G} : mk' N x = mk' N y ↔ ∃ z ∈ N, x * z = y :=
  QuotientGroup.eq'.trans <| by
    simp only [← _root_.eq_inv_mul_iff_mul_eq, exists_prop, exists_eq_right]
#align quotient_group.mk'_eq_mk' QuotientGroup.mk'_eq_mk'
#align quotient_add_group.mk'_eq_mk' QuotientAddGroup.mk'_eq_mk'

/-- Two `MonoidHom`s from a quotient group are equal if their compositions with
`QuotientGroup.mk'` are equal.

See note [partially-applied ext lemmas]. -/
@[to_additive (attr := ext 1100) "Two `AddMonoidHoms`s from an additive quotient group are equal if
 their compositions with `AddQuotientGroup.mk'` are equal.

 See note [partially-applied ext lemmas]. "]
theorem monoidHom_ext ⦃f g : G ⧸ N →* H⦄ (h : f.comp (mk' N) = g.comp (mk' N)) : f = g :=
  MonoidHom.ext fun x => QuotientGroup.induction_on x <| (FunLike.congr_fun h : _)
#align quotient_group.monoid_hom_ext QuotientGroup.monoidHom_ext
#align quotient_add_group.add_monoid_hom_ext QuotientAddGroup.addMonoidHom_ext

@[to_additive (attr := simp)]
theorem eq_one_iff {N : Subgroup G} [nN : N.Normal] (x : G) : (x : G ⧸ N) = 1 ↔ x ∈ N := by
  refine' QuotientGroup.eq.trans _
  rw [mul_one, Subgroup.inv_mem_iff]
#align quotient_group.eq_one_iff QuotientGroup.eq_one_iff
#align quotient_add_group.eq_zero_iff QuotientAddGroup.eq_zero_iff

@[to_additive (attr := simp)]
theorem ker_mk' : MonoidHom.ker (QuotientGroup.mk' N : G →* G ⧸ N) = N :=
  Subgroup.ext eq_one_iff
#align quotient_group.ker_mk QuotientGroup.ker_mk'
#align quotient_add_group.ker_mk QuotientAddGroup.ker_mk'
-- porting note: I think this is misnamed without the prime

@[to_additive]
theorem eq_iff_div_mem {N : Subgroup G} [nN : N.Normal] {x y : G} : (x : G ⧸ N) = y ↔ x / y ∈ N :=
  by
    refine' eq_comm.trans (QuotientGroup.eq.trans _)
    rw [nN.mem_comm_iff, div_eq_mul_inv]
#align quotient_group.eq_iff_div_mem QuotientGroup.eq_iff_div_mem
#align quotient_add_group.eq_iff_sub_mem QuotientAddGroup.eq_iff_sub_mem

-- for commutative groups we don't need normality assumption

@[to_additive]
instance Quotient.commGroup {G : Type _} [CommGroup G] (N : Subgroup G) : CommGroup (G ⧸ N) :=
  { @QuotientGroup.Quotient.group _ _ N N.normal_of_comm with
    mul_comm := fun a b => Quotient.inductionOn₂' a b fun a b => congr_arg mk (mul_comm a b) }
#align quotient_group.quotient.comm_group QuotientGroup.Quotient.commGroup
#align quotient_add_group.quotient.add_comm_group QuotientAddGroup.Quotient.addCommGroup

local notation " Q " => G ⧸ N

@[to_additive (attr := simp)]
theorem mk_one : ((1 : G) : Q ) = 1 :=
  rfl
#align quotient_group.coe_one QuotientGroup.mk_one
#align quotient_add_group.coe_zero QuotientAddGroup.mk_zero

@[to_additive (attr := simp)]
theorem mk_mul (a b : G) : ((a * b : G) : Q ) = a * b :=
  rfl
#align quotient_group.coe_mul QuotientGroup.mk_mul
#align quotient_add_group.coe_add QuotientAddGroup.mk_add

@[to_additive (attr := simp)]
theorem mk_inv (a : G) : ((a⁻¹ : G) : Q ) = (a : Q)⁻¹ :=
  rfl
#align quotient_group.coe_inv QuotientGroup.mk_inv
#align quotient_add_group.coe_neg QuotientAddGroup.mk_neg

@[to_additive (attr := simp)]
theorem mk_div (a b : G) : ((a / b : G) : Q ) = a / b :=
  rfl
#align quotient_group.coe_div QuotientGroup.mk_div
#align quotient_add_group.coe_sub QuotientAddGroup.mk_sub

@[to_additive (attr := simp)]
theorem mk_pow (a : G) (n : ℕ) : ((a ^ n : G) : Q ) = (a : Q) ^ n :=
  rfl
#align quotient_group.coe_pow QuotientGroup.mk_pow
#align quotient_add_group.coe_nsmul QuotientAddGroup.mk_nsmul

@[to_additive (attr := simp)]
theorem mk_zpow (a : G) (n : ℤ) : ((a ^ n : G) : Q ) = (a : Q) ^ n :=
  rfl
#align quotient_group.coe_zpow QuotientGroup.mk_zpow
#align quotient_add_group.coe_zsmul QuotientAddGroup.mk_zsmul

/-- A group homomorphism `φ : G →* H` with `N ⊆ ker(φ)` descends (i.e. `lift`s) to a
group homomorphism `G/N →* H`. -/
@[to_additive "An `AddGroup` homomorphism `φ : G →+ H` with `N ⊆ ker(φ)` descends (i.e. `lift`s)
 to a group homomorphism `G/N →* H`."]
def lift (φ : G →* H) (HN : ∀ x ∈ N, φ x = 1) : Q →* H :=
  (QuotientGroup.con N).lift φ fun x y h =>
    by
    simp only [QuotientGroup.con, leftRel_apply, Con.rel_mk] at h
    rw [Con.ker_rel]
    calc
      φ x = φ (y * (x⁻¹ * y)⁻¹) := by rw [mul_inv_rev, inv_inv, mul_inv_cancel_left]
      _ = φ y := by rw [φ.map_mul, HN _ (N.inv_mem h), mul_one]

#align quotient_group.lift QuotientGroup.lift
#align quotient_add_group.lift QuotientAddGroup.lift

@[to_additive (attr := simp)]
theorem lift_mk {φ : G →* H} (HN : ∀ x ∈ N, φ x = 1) (g : G) : lift N φ HN (g : Q ) = φ g :=
  rfl
#align quotient_group.lift_mk QuotientGroup.lift_mk
#align quotient_add_group.lift_mk QuotientAddGroup.lift_mk

@[to_additive (attr := simp)]
theorem lift_mk' {φ : G →* H} (HN : ∀ x ∈ N, φ x = 1) (g : G) : lift N φ HN (mk g : Q ) = φ g :=
  rfl
-- TODO: replace `mk` with  `mk'`)
#align quotient_group.lift_mk' QuotientGroup.lift_mk'
#align quotient_add_group.lift_mk' QuotientAddGroup.lift_mk'

@[to_additive (attr := simp)]
theorem lift_quot_mk {φ : G →* H} (HN : ∀ x ∈ N, φ x = 1) (g : G) :
    lift N φ HN (Quot.mk _ g : Q ) = φ g :=
  rfl
#align quotient_group.lift_quot_mk QuotientGroup.lift_quot_mk
#align quotient_add_group.lift_quot_mk QuotientAddGroup.lift_quot_mk

/-- A group homomorphism `f : G →* H` induces a map `G/N →* H/M` if `N ⊆ f⁻¹(M)`. -/
@[to_additive
      "An `AddGroup` homomorphism `f : G →+ H` induces a map `G/N →+ H/M` if `N ⊆ f⁻¹(M)`."]
def map (M : Subgroup H) [M.Normal] (f : G →* H) (h : N ≤ M.comap f) : G ⧸ N →* H ⧸ M := by
  refine' QuotientGroup.lift N ((mk' M).comp f) _
  intro x hx
  refine' QuotientGroup.eq.2 _
  rw [mul_one, Subgroup.inv_mem_iff]
  exact h hx
#align quotient_group.map QuotientGroup.map
#align quotient_add_group.map QuotientAddGroup.map

@[to_additive (attr := simp)]
theorem map_mk (M : Subgroup H) [M.Normal] (f : G →* H) (h : N ≤ M.comap f) (x : G) :
    map N M f h ↑x = ↑(f x) :=
  rfl
#align quotient_group.map_coe QuotientGroup.map_mk
#align quotient_add_group.map_coe QuotientAddGroup.map_mk

@[to_additive]
theorem map_mk' (M : Subgroup H) [M.Normal] (f : G →* H) (h : N ≤ M.comap f) (x : G) :
    map N M f h (mk' _ x) = ↑(f x) :=
  rfl
#align quotient_group.map_mk' QuotientGroup.map_mk'
#align quotient_add_group.map_mk' QuotientAddGroup.map_mk'

@[to_additive]
theorem map_id_apply (h : N ≤ Subgroup.comap (MonoidHom.id _) N := (Subgroup.comap_id N).le) (x) :
    map N N (MonoidHom.id _) h x = x :=
  induction_on' x fun _x => rfl
#align quotient_group.map_id_apply QuotientGroup.map_id_apply
#align quotient_add_group.map_id_apply QuotientAddGroup.map_id_apply

@[to_additive (attr := simp)]
theorem map_id (h : N ≤ Subgroup.comap (MonoidHom.id _) N := (Subgroup.comap_id N).le) :
    map N N (MonoidHom.id _) h = MonoidHom.id _ :=
  MonoidHom.ext (map_id_apply N h)
#align quotient_group.map_id QuotientGroup.map_id
#align quotient_add_group.map_id QuotientAddGroup.map_id

@[to_additive (attr := simp)]
theorem map_map {I : Type _} [Group I] (M : Subgroup H) (O : Subgroup I) [M.Normal] [O.Normal]
    (f : G →* H) (g : H →* I) (hf : N ≤ Subgroup.comap f M) (hg : M ≤ Subgroup.comap g O)
    (hgf : N ≤ Subgroup.comap (g.comp f) O :=
      hf.trans ((Subgroup.comap_mono hg).trans_eq (Subgroup.comap_comap _ _ _)))
    (x : G ⧸ N) : map M O g hg (map N M f hf x) = map N O (g.comp f) hgf x := by
  refine' induction_on' x fun x => _
  simp only [map_mk, MonoidHom.comp_apply]
#align quotient_group.map_map QuotientGroup.map_map
#align quotient_add_group.map_map QuotientAddGroup.map_map

@[to_additive (attr := simp)]
theorem map_comp_map {I : Type _} [Group I] (M : Subgroup H) (O : Subgroup I) [M.Normal] [O.Normal]
    (f : G →* H) (g : H →* I) (hf : N ≤ Subgroup.comap f M) (hg : M ≤ Subgroup.comap g O)
    (hgf : N ≤ Subgroup.comap (g.comp f) O :=
      hf.trans ((Subgroup.comap_mono hg).trans_eq (Subgroup.comap_comap _ _ _))) :
    (map M O g hg).comp (map N M f hf) = map N O (g.comp f) hgf :=
  MonoidHom.ext (map_map N M O f g hf hg hgf)
#align quotient_group.map_comp_map QuotientGroup.map_comp_map
#align quotient_add_group.map_comp_map QuotientAddGroup.map_comp_map

section congr

variable (G' : Subgroup G) (H' : Subgroup H) [Subgroup.Normal G'] [Subgroup.Normal H']

/-- `QuotientGroup.congr` lifts the isomorphism `e : G ≃ H` to `G ⧸ G' ≃ H ⧸ H'`,
given that `e` maps `G` to `H`. -/
@[to_additive "`QuotientAddGroup.congr` lifts the isomorphism `e : G ≃ H` to `G ⧸ G' ≃ H ⧸ H'`,
 given that `e` maps `G` to `H`."]
def congr (e : G ≃* H) (he : G'.map e = H') : G ⧸ G' ≃* H ⧸ H' :=
  { map G' H' e (he ▸ G'.le_comap_map (e : G →* H)) with
    toFun := map G' H' e (he ▸ G'.le_comap_map (e : G →* H))
    invFun := map H' G' e.symm (he ▸ (G'.map_equiv_eq_comap_symm e).le)
    left_inv := fun x => by
      rw [map_map G' H' G' e e.symm (he ▸ G'.le_comap_map (e : G →* H))
        (he ▸ (G'.map_equiv_eq_comap_symm e).le)]
      simp only [map_map, ← MulEquiv.coe_monoidHom_trans, MulEquiv.self_trans_symm,
        MulEquiv.coe_monoidHom_refl, map_id_apply]
    right_inv := fun x => by
      rw [map_map H' G' H' e.symm e (he ▸ (G'.map_equiv_eq_comap_symm e).le)
        (he ▸ G'.le_comap_map (e : G →* H)) ]
      simp only [← MulEquiv.coe_monoidHom_trans, MulEquiv.symm_trans_self,
        MulEquiv.coe_monoidHom_refl, map_id_apply] }
#align quotient_group.congr QuotientGroup.congr
#align quotient_add_group.congr QuotientAddGroup.congr

@[simp]
theorem congr_mk (e : G ≃* H) (he : G'.map ↑e = H') (x) : congr G' H' e he (mk x) = e x :=
  rfl
#align quotient_group.congr_mk QuotientGroup.congr_mk

theorem congr_mk' (e : G ≃* H) (he : G'.map ↑e = H') (x) :
    congr G' H' e he (mk' G' x) = mk' H' (e x) :=
  rfl
#align quotient_group.congr_mk' QuotientGroup.congr_mk'

@[simp]
theorem congr_apply (e : G ≃* H) (he : G'.map ↑e = H') (x : G) :
    congr G' H' e he x = mk' H' (e x) :=
  rfl
#align quotient_group.congr_apply QuotientGroup.congr_apply

@[simp]
theorem congr_refl (he : G'.map (MulEquiv.refl G : G →* G) = G' := Subgroup.map_id G') :
    congr G' G' (MulEquiv.refl G) he = MulEquiv.refl (G ⧸ G') := by
  ext ⟨x⟩
  rfl
#align quotient_group.congr_refl QuotientGroup.congr_refl

@[simp]
theorem congr_symm (e : G ≃* H) (he : G'.map ↑e = H') :
    (congr G' H' e he).symm = congr H' G' e.symm ((Subgroup.map_symm_eq_iff_map_eq _).mpr he) :=
  rfl
#align quotient_group.congr_symm QuotientGroup.congr_symm

end congr

variable (φ : G →* H)

open MonoidHom

/-- The induced map from the quotient by the kernel to the codomain. -/
@[to_additive "The induced map from the quotient by the kernel to the codomain."]
def kerLift : G ⧸ ker φ →* H :=
  lift _ φ fun _g => φ.mem_ker.mp
#align quotient_group.ker_lift QuotientGroup.kerLift
#align quotient_add_group.ker_lift QuotientAddGroup.kerLift

@[to_additive (attr := simp)]
theorem kerLift_mk (g : G) : (kerLift φ) g = φ g :=
  lift_mk _ _ _
#align quotient_group.ker_lift_mk QuotientGroup.kerLift_mk
#align quotient_add_group.ker_lift_mk QuotientAddGroup.kerLift_mk

@[to_additive (attr := simp)]
theorem kerLift_mk' (g : G) : (kerLift φ) (mk g) = φ g :=
  lift_mk' _ _ _
#align quotient_group.ker_lift_mk' QuotientGroup.kerLift_mk'
#align quotient_add_group.ker_lift_mk' QuotientAddGroup.kerLift_mk'

@[to_additive]
theorem kerLift_injective : Injective (kerLift φ) := fun a b =>
  Quotient.inductionOn₂' a b fun a b (h : φ a = φ b) =>
    Quotient.sound' <| by rw [leftRel_apply, mem_ker, φ.map_mul, ← h, φ.map_inv, inv_mul_self]
#align quotient_group.ker_lift_injective QuotientGroup.kerLift_injective
#align quotient_add_group.ker_lift_injective QuotientAddGroup.kerLift_injective

-- Note that `ker φ` isn't definitionally `ker (φ.rangeRestrict)`
-- so there is a bit of annoying code duplication here
/-- The induced map from the quotient by the kernel to the range. -/
@[to_additive "The induced map from the quotient by the kernel to the range."]
def rangeKerLift : G ⧸ ker φ →* φ.range :=
  lift _ φ.rangeRestrict fun g hg => (mem_ker _).mp <| by rwa [ker_rangeRestrict]
#align quotient_group.range_ker_lift QuotientGroup.rangeKerLift
#align quotient_add_group.range_ker_lift QuotientAddGroup.rangeKerLift

@[to_additive]
theorem rangeKerLift_injective : Injective (rangeKerLift φ) := fun a b =>
  Quotient.inductionOn₂' a b fun a b (h : φ.rangeRestrict a = φ.rangeRestrict b) =>
    Quotient.sound' <| by
      rw [leftRel_apply, ← ker_rangeRestrict, mem_ker, φ.rangeRestrict.map_mul, ← h,
        φ.rangeRestrict.map_inv, inv_mul_self]
#align quotient_group.range_ker_lift_injective QuotientGroup.rangeKerLift_injective
#align quotient_add_group.range_ker_lift_injective QuotientAddGroup.rangeKerLift_injective

@[to_additive]
theorem rangeKerLift_surjective : Surjective (rangeKerLift φ) := by
  rintro ⟨_, g, rfl⟩
  use mk g
  rfl
#align quotient_group.range_ker_lift_surjective QuotientGroup.rangeKerLift_surjective
#align quotient_add_group.range_ker_lift_surjective QuotientAddGroup.rangeKerLift_surjective

/-- **Noether's first isomorphism theorem** (a definition): the canonical isomorphism between
`G/(ker φ)` to `range φ`. -/
@[to_additive "The first isomorphism theorem (a definition): the canonical isomorphism between
`G/(ker φ)` to `range φ`."]
noncomputable def quotientKerEquivRange : G ⧸ ker φ ≃* range φ :=
  MulEquiv.ofBijective (rangeKerLift φ) ⟨rangeKerLift_injective φ, rangeKerLift_surjective φ⟩
#align quotient_group.quotient_ker_equiv_range QuotientGroup.quotientKerEquivRange
#align quotient_add_group.quotient_ker_equiv_range QuotientAddGroup.quotientKerEquivRange

/-- The canonical isomorphism `G/(ker φ) ≃* H` induced by a homomorphism `φ : G →* H`
with a right inverse `ψ : H → G`. -/
@[to_additive (attr := simps) "The canonical isomorphism `G/(ker φ) ≃+ H` induced by a homomorphism
`φ : G →+ H` with a right inverse `ψ : H → G`."]
def quotientKerEquivOfRightInverse (ψ : H → G) (hφ : RightInverse ψ φ) : G ⧸ ker φ ≃* H :=
  { kerLift φ with
    toFun := kerLift φ
    invFun := mk ∘ ψ
    left_inv := fun x => kerLift_injective φ (by rw [Function.comp_apply, kerLift_mk', hφ])
    right_inv := hφ }
#align quotient_group.quotient_ker_equiv_of_right_inverse QuotientGroup.quotientKerEquivOfRightInverse
#align quotient_add_group.quotient_ker_equiv_of_right_inverse QuotientAddGroup.quotientKerEquivOfRightInverse

/-- The canonical isomorphism `G/⊥ ≃* G`. -/
@[to_additive (attr := simps!) "The canonical isomorphism `G/⊥ ≃+ G`."]
def quotientBot : G ⧸ (⊥ : Subgroup G) ≃* G :=
  quotientKerEquivOfRightInverse (MonoidHom.id G) id fun _x => rfl
#align quotient_group.quotient_bot QuotientGroup.quotientBot
#align quotient_add_group.quotient_bot QuotientAddGroup.quotientBot

/-- The canonical isomorphism `G/(ker φ) ≃* H` induced by a surjection `φ : G →* H`.

For a `computable` version, see `QuotientGroup.quotientKerEquivOfRightInverse`.
-/
@[to_additive "The canonical isomorphism `G/(ker φ) ≃+ H` induced by a surjection `φ : G →+ H`.
For a `computable` version, see `QuotientAddGroup.quotientKerEquivOfRightInverse`."]
noncomputable def quotientKerEquivOfSurjective (hφ : Surjective φ) : G ⧸ ker φ ≃* H :=
  quotientKerEquivOfRightInverse φ _ hφ.hasRightInverse.choose_spec
#align quotient_group.quotient_ker_equiv_of_surjective QuotientGroup.quotientKerEquivOfSurjective
#align quotient_add_group.quotient_ker_equiv_of_surjective QuotientAddGroup.quotientKerEquivOfSurjective

/-- If two normal subgroups `M` and `N` of `G` are the same, their quotient groups are
isomorphic. -/
@[to_additive "If two normal subgroups `M` and `N` of `G` are the same, their quotient groups are
isomorphic."]
def quotientMulEquivOfEq {M N : Subgroup G} [M.Normal] [N.Normal] (h : M = N) : G ⧸ M ≃* G ⧸ N :=
  { Subgroup.quotientEquivOfEq h with
    map_mul' := fun q r => Quotient.inductionOn₂' q r fun _g _h => rfl }
#align quotient_group.quotient_mul_equiv_of_eq QuotientGroup.quotientMulEquivOfEq
#align quotient_add_group.quotient_add_equiv_of_eq QuotientAddGroup.quotientAddEquivOfEq

@[to_additive (attr := simp)]
theorem quotientMulEquivOfEq_mk {M N : Subgroup G} [M.Normal] [N.Normal] (h : M = N) (x : G) :
    QuotientGroup.quotientMulEquivOfEq h (QuotientGroup.mk x) = QuotientGroup.mk x :=
  rfl
#align quotient_group.quotient_mul_equiv_of_eq_mk QuotientGroup.quotientMulEquivOfEq_mk
#align quotient_add_group.quotient_add_equiv_of_eq_mk QuotientAddGroup.quotientAddEquivOfEq_mk

/-- Let `A', A, B', B` be subgroups of `G`. If `A' ≤ B'` and `A ≤ B`,
then there is a map `A / (A' ⊓ A) →* B / (B' ⊓ B)` induced by the inclusions. -/
@[to_additive "Let `A', A, B', B` be subgroups of `G`. If `A' ≤ B'` and `A ≤ B`, then there is a map
`A / (A' ⊓ A) →+ B / (B' ⊓ B)` induced by the inclusions."]
def quotientMapSubgroupOfOfLe {A' A B' B : Subgroup G} [_hAN : (A'.subgroupOf A).Normal]
    [_hBN : (B'.subgroupOf B).Normal] (h' : A' ≤ B') (h : A ≤ B) :
    A ⧸ A'.subgroupOf A →* B ⧸ B'.subgroupOf B :=
  map _ _ (Subgroup.inclusion h) <| Subgroup.comap_mono h'
#align quotient_group.quotient_map_subgroup_of_of_le QuotientGroup.quotientMapSubgroupOfOfLe
#align quotient_add_group.quotient_map_add_subgroup_of_of_le QuotientAddGroup.quotientMapAddSubgroupOfOfLe

@[to_additive (attr := simp)]
theorem quotientMapSubgroupOfOfLe_mk {A' A B' B : Subgroup G} [_hAN : (A'.subgroupOf A).Normal]
    [_hBN : (B'.subgroupOf B).Normal] (h' : A' ≤ B') (h : A ≤ B) (x : A) :
    quotientMapSubgroupOfOfLe h' h x = ↑(Subgroup.inclusion h x : B) :=
  rfl
#align quotient_group.quotient_map_subgroup_of_of_le_coe QuotientGroup.quotientMapSubgroupOfOfLe_mk
#align quotient_add_group.quotient_map_add_subgroup_of_of_le_coe QuotientAddGroup.quotientMapAddSubgroupOfOfLe_mk

/-- Let `A', A, B', B` be subgroups of `G`.
If `A' = B'` and `A = B`, then the quotients `A / (A' ⊓ A)` and `B / (B' ⊓ B)` are isomorphic.

Applying this equiv is nicer than rewriting along the equalities, since the type of
`(A'.subgroupOf A : Subgroup A)` depends on on `A`.
-/
@[to_additive "Let `A', A, B', B` be subgroups of `G`. If `A' = B'` and `A = B`, then the quotients
`A / (A' ⊓ A)` and `B / (B' ⊓ B)` are isomorphic. Applying this equiv is nicer than rewriting along
the equalities, since the type of `(A'.addSubgroupOf A : AddSubgroup A)` depends on on `A`. "]
def equivQuotientSubgroupOfOfEq {A' A B' B : Subgroup G} [hAN : (A'.subgroupOf A).Normal]
    [hBN : (B'.subgroupOf B).Normal] (h' : A' = B') (h : A = B) :
    A ⧸ A'.subgroupOf A ≃* B ⧸ B'.subgroupOf B :=
  MonoidHom.toMulEquiv (quotientMapSubgroupOfOfLe h'.le h.le) (quotientMapSubgroupOfOfLe h'.ge h.ge)
    (by ext ⟨x, hx⟩; rfl)
    (by ext ⟨x, hx⟩; rfl)
#align quotient_group.equiv_quotient_subgroup_of_of_eq QuotientGroup.equivQuotientSubgroupOfOfEq
#align quotient_add_group.equiv_quotient_add_subgroup_of_of_eq QuotientAddGroup.equivQuotientAddSubgroupOfOfEq

section ZPow

variable {A B C : Type u} [CommGroup A] [CommGroup B] [CommGroup C]

variable (f : A →* B) (g : B →* A) (e : A ≃* B) (d : B ≃* C) (n : ℤ)

/-- The map of quotients by powers of an integer induced by a group homomorphism. -/
@[to_additive "The map of quotients by multiples of an integer induced by an additive group
homomorphism."]
def homQuotientZPowOfHom :
    A ⧸ (zpowGroupHom n : A →* A).range →* B ⧸ (zpowGroupHom n : B →* B).range :=
  lift _ ((mk' _).comp f) fun g ⟨h, (hg : h ^ n = g)⟩ =>
    (eq_one_iff _).mpr ⟨f h, by
      simp only [← hg, map_zpow, zpowGroupHom_apply]⟩
#align quotient_group.hom_quotient_zpow_of_hom QuotientGroup.homQuotientZPowOfHom
#align quotient_add_group.hom_quotient_zsmul_of_hom QuotientAddGroup.homQuotientZSMulOfHom

@[to_additive (attr := simp)]
theorem homQuotientZPowOfHom_id : homQuotientZPowOfHom (MonoidHom.id A) n = MonoidHom.id _ :=
  monoidHom_ext _ rfl
#align quotient_group.hom_quotient_zpow_of_hom_id QuotientGroup.homQuotientZPowOfHom_id
#align quotient_add_group.hom_quotient_zsmul_of_hom_id QuotientAddGroup.homQuotientZSMulOfHom_id

@[to_additive (attr := simp)]
theorem homQuotientZPowOfHom_comp :
    homQuotientZPowOfHom (f.comp g) n =
      (homQuotientZPowOfHom f n).comp (homQuotientZPowOfHom g n) :=
  monoidHom_ext _ rfl
#align quotient_group.hom_quotient_zpow_of_hom_comp QuotientGroup.homQuotientZPowOfHom_comp
#align quotient_add_group.hom_quotient_zsmul_of_hom_comp QuotientAddGroup.homQuotientZSMulOfHom_comp

@[to_additive (attr := simp)]
theorem homQuotientZPowOfHom_comp_of_rightInverse (i : Function.RightInverse g f) :
    (homQuotientZPowOfHom f n).comp (homQuotientZPowOfHom g n) = MonoidHom.id _ :=
  monoidHom_ext _ <| MonoidHom.ext fun x => congrArg _ <| i x
#align quotient_group.hom_quotient_zpow_of_hom_comp_of_right_inverse QuotientGroup.homQuotientZPowOfHom_comp_of_rightInverse
#align quotient_add_group.hom_quotient_zsmul_of_hom_comp_of_right_inverse QuotientAddGroup.homQuotientZSMulOfHom_comp_of_rightInverse

/-- The equivalence of quotients by powers of an integer induced by a group isomorphism. -/
@[to_additive "The equivalence of quotients by multiples of an integer induced by an additive group
isomorphism."]
def equivQuotientZPowOfEquiv :
    A ⧸ (zpowGroupHom n : A →* A).range ≃* B ⧸ (zpowGroupHom n : B →* B).range :=
  MonoidHom.toMulEquiv _ _
    (homQuotientZPowOfHom_comp_of_rightInverse (e.symm : B →* A) (e : A →* B) n e.left_inv)
    (homQuotientZPowOfHom_comp_of_rightInverse (e : A →* B) (e.symm : B →* A) n e.right_inv)
    -- porting note: had to explicitly coerce the `MulEquiv`s to `MonoidHom`s
#align quotient_group.equiv_quotient_zpow_of_equiv QuotientGroup.equivQuotientZPowOfEquiv
#align quotient_add_group.equiv_quotient_zsmul_of_equiv QuotientAddGroup.equivQuotientZSMulOfEquiv

@[to_additive (attr := simp)]
theorem equivQuotientZPowOfEquiv_refl :
    MulEquiv.refl (A ⧸ (zpowGroupHom n : A →* A).range) =
      equivQuotientZPowOfEquiv (MulEquiv.refl A) n := by
  ext x
  rw [← Quotient.out_eq' x]
  rfl
#align quotient_group.equiv_quotient_zpow_of_equiv_refl QuotientGroup.equivQuotientZPowOfEquiv_refl
#align quotient_add_group.equiv_quotient_zsmul_of_equiv_refl QuotientAddGroup.equivQuotientZSMulOfEquiv_refl

@[to_additive (attr := simp)]
theorem equivQuotientZPowOfEquiv_symm :
    (equivQuotientZPowOfEquiv e n).symm = equivQuotientZPowOfEquiv e.symm n :=
  rfl
#align quotient_group.equiv_quotient_zpow_of_equiv_symm QuotientGroup.equivQuotientZPowOfEquiv_symm
#align quotient_add_group.equiv_quotient_zsmul_of_equiv_symm QuotientAddGroup.equivQuotientZSMulOfEquiv_symm

@[to_additive (attr := simp)]
theorem equivQuotientZPowOfEquiv_trans :
    (equivQuotientZPowOfEquiv e n).trans (equivQuotientZPowOfEquiv d n) =
      equivQuotientZPowOfEquiv (e.trans d) n := by
  ext x
  rw [← Quotient.out_eq' x]
  rfl
#align quotient_group.equiv_quotient_zpow_of_equiv_trans QuotientGroup.equivQuotientZPowOfEquiv_trans
#align quotient_add_group.equiv_quotient_zsmul_of_equiv_trans QuotientAddGroup.equivQuotientZSMulOfEquiv_trans

end ZPow

section SndIsomorphismThm

open Subgroup

/-- **Noether's second isomorphism theorem**: given two subgroups `H` and `N` of a group `G`, where
`N` is normal, defines an isomorphism between `H/(H ∩ N)` and `(HN)/N`. -/
@[to_additive "The second isomorphism theorem: given two subgroups `H` and `N` of a group `G`, where
`N` is normal, defines an isomorphism between `H/(H ∩ N)` and `(H + N)/N`"]
noncomputable def quotientInfEquivProdNormalQuotient (H N : Subgroup G) [N.Normal] :
    H ⧸ N.subgroupOf H ≃* _ ⧸ N.subgroupOf (H ⊔ N) :=
  let
    φ :-- φ is the natural homomorphism H →* (HN)/N.
      H →*
      _ ⧸ N.subgroupOf (H ⊔ N) :=
    (mk' <| N.subgroupOf (H ⊔ N)).comp (inclusion le_sup_left)
  have φ_surjective : Surjective φ := fun x =>
    x.inductionOn' <| by
      rintro ⟨y, hy : y ∈ (H ⊔ N)⟩;
      rw [←SetLike.mem_coe] at hy
      rw [mul_normal H N] at hy
      rcases hy with ⟨h, n, hh, hn, rfl⟩
      use ⟨h, hh⟩
      let _ : Setoid ↑(H ⊔ N) :=
        (@leftRel ↑(H ⊔ N) (H ⊔ N : Subgroup G).toGroup (N.subgroupOf (H ⊔ N)))
      -- porting note: Lean couldn't find this automatically
      refine Quotient.eq.mpr ?_
      change Setoid.r _ _
      rw [leftRel_apply]
      change h⁻¹ * (h * n) ∈ N
      rwa [← mul_assoc, inv_mul_self, one_mul]
  (quotientMulEquivOfEq (by simp [← comap_ker])).trans (quotientKerEquivOfSurjective φ φ_surjective)
#align quotient_group.quotient_inf_equiv_prod_normal_quotient QuotientGroup.quotientInfEquivProdNormalQuotient
#align quotient_add_group.quotient_inf_equiv_sum_normal_quotient QuotientAddGroup.quotientInfEquivSumNormalQuotient

end SndIsomorphismThm

section ThirdIsoThm

variable (M : Subgroup G) [nM : M.Normal]

@[to_additive]
instance map_normal : (M.map (QuotientGroup.mk' N)).Normal :=
  nM.map _ mk_surjective
#align quotient_group.map_normal QuotientGroup.map_normal
#align quotient_add_group.map_normal QuotientAddGroup.map_normal

variable (h : N ≤ M)

/-- The map from the third isomorphism theorem for groups: `(G / N) / (M / N) → G / M`. -/
@[to_additive "The map from the third isomorphism theorem for additive groups:
`(A / N) / (M / N) → A / M`."]
def quotientQuotientEquivQuotientAux : (G ⧸ N) ⧸ M.map (mk' N) →* G ⧸ M :=
  lift (M.map (mk' N)) (map N M (MonoidHom.id G) h)
    (by
      rintro _ ⟨x, hx, rfl⟩
      rw [map_mk' N M _ _ x]
      exact (QuotientGroup.eq_one_iff _).mpr hx)
#align quotient_group.quotient_quotient_equiv_quotient_aux QuotientGroup.quotientQuotientEquivQuotientAux
#align quotient_add_group.quotient_quotient_equiv_quotient_aux QuotientAddGroup.quotientQuotientEquivQuotientAux

@[to_additive (attr := simp)]
theorem quotientQuotientEquivQuotientAux_mk (x : G ⧸ N) :
    quotientQuotientEquivQuotientAux N M h x = QuotientGroup.map N M (MonoidHom.id G) h x :=
  QuotientGroup.lift_mk' _ _ x
#align quotient_group.quotient_quotient_equiv_quotient_aux_coe QuotientGroup.quotientQuotientEquivQuotientAux_mk
#align quotient_add_group.quotient_quotient_equiv_quotient_aux_coe QuotientAddGroup.quotientQuotientEquivQuotientAux_mk

@[to_additive]
theorem quotientQuotientEquivQuotientAux_mk_mk (x : G) :
    quotientQuotientEquivQuotientAux N M h (x : G ⧸ N) = x :=
  QuotientGroup.lift_mk' (M.map (mk' N)) _ x
#align quotient_group.quotient_quotient_equiv_quotient_aux_coe_coe QuotientGroup.quotientQuotientEquivQuotientAux_mk_mk
#align quotient_add_group.quotient_quotient_equiv_quotient_aux_coe_coe QuotientAddGroup.quotientQuotientEquivQuotientAux_mk_mk

/-- **Noether's third isomorphism theorem** for groups: `(G / N) / (M / N) ≃* G / M`. -/
@[to_additive
      "**Noether's third isomorphism theorem** for additive groups: `(A / N) / (M / N) ≃+ A / M`."]
def quotientQuotientEquivQuotient : (G ⧸ N) ⧸ M.map (QuotientGroup.mk' N) ≃* G ⧸ M :=
  MonoidHom.toMulEquiv (quotientQuotientEquivQuotientAux N M h)
    (QuotientGroup.map _ _ (QuotientGroup.mk' N) (Subgroup.le_comap_map _ _))
    (by ext; simp)
    (by ext; simp)
#align quotient_group.quotient_quotient_equiv_quotient QuotientGroup.quotientQuotientEquivQuotient
#align quotient_add_group.quotient_quotient_equiv_quotient QuotientAddGroup.quotientQuotientEquivQuotient

end ThirdIsoThm

section trivial

@[to_additive]
theorem subsingleton_quotient_top : Subsingleton (G ⧸ (⊤ : Subgroup G)) := by
  dsimp [HasQuotient.Quotient, QuotientGroup.instHasQuotientSubgroup, Quotient]
  rw [leftRel_eq]
  exact Trunc.instSubsingletonTrunc
#align quotient_group.subsingleton_quotient_top QuotientGroup.subsingleton_quotient_top
#align quotient_add_group.subsingleton_quotient_top QuotientAddGroup.subsingleton_quotient_top

/-- If the quotient by a subgroup gives a singleton then the subgroup is the whole group. -/
@[to_additive "If the quotient by an additive subgroup gives a singleton then the additive subgroup
is the whole additive group."]
theorem subgroup_eq_top_of_subsingleton (H : Subgroup G) (h : Subsingleton (G ⧸ H)) : H = ⊤ :=
  top_unique fun x _ =>
    by
    have this : 1⁻¹ * x ∈ H := QuotientGroup.eq.1 (Subsingleton.elim _ _)
    rwa [inv_one, one_mul] at this
#align quotient_group.subgroup_eq_top_of_subsingleton QuotientGroup.subgroup_eq_top_of_subsingleton
#align quotient_add_group.add_subgroup_eq_top_of_subsingleton QuotientAddGroup.addSubgroup_eq_top_of_subsingleton

end trivial

@[to_additive]
theorem comap_comap_center {H₁ : Subgroup G} [H₁.Normal] {H₂ : Subgroup (G ⧸ H₁)} [H₂.Normal] :
    ((Subgroup.center ((G ⧸ H₁) ⧸ H₂)).comap (mk' H₂)).comap (mk' H₁) =
      (Subgroup.center (G ⧸ H₂.comap (mk' H₁))).comap (mk' (H₂.comap (mk' H₁))) := by
  ext x
  simp only [mk'_apply, Subgroup.mem_comap, Subgroup.mem_center_iff, forall_mk, ← mk_mul,
    eq_iff_div_mem, mk_div]
#align quotient_group.comap_comap_center QuotientGroup.comap_comap_center
#align quotient_add_group.comap_comap_center QuotientAddGroup.comap_comap_center

end QuotientGroup

namespace Group

open Classical

open QuotientGroup Subgroup

variable {F G H : Type u} [Group F] [Group G] [Group H] [Fintype F] [Fintype H]

variable (f : F →* G) (g : G →* H)

/-- If `F` and `H` are finite such that `ker(G →* H) ≤ im(F →* G)`, then `G` is finite. -/
@[to_additive "If `F` and `H` are finite such that `ker(G →+ H) ≤ im(F →+ G)`, then `G` is finite."]
noncomputable def fintypeOfKerLeRange (h : g.ker ≤ f.range) : Fintype G :=
  @Fintype.ofEquiv _ _
    (@instFintypeProd _ _ (Fintype.ofInjective _ <| kerLift_injective g) <|
      Fintype.ofInjective _ <| inclusion_injective h)
    groupEquivQuotientProdSubgroup.symm
#align group.fintype_of_ker_le_range Group.fintypeOfKerLeRange
#align add_group.fintype_of_ker_le_range AddGroup.fintypeOfKerLeRange

/-- If `F` and `H` are finite such that `ker(G →* H) = im(F →* G)`, then `G` is finite. -/
@[to_additive "If `F` and `H` are finite such that `ker(G →+ H) = im(F →+ G)`, then `G` is finite."]
noncomputable def fintypeOfKerEqRange (h : g.ker = f.range) : Fintype G :=
  fintypeOfKerLeRange _ _ h.le
#align group.fintype_of_ker_eq_range Group.fintypeOfKerEqRange
#align add_group.fintype_of_ker_eq_range AddGroup.fintypeOfKerEqRange

/-- If `ker(G →* H)` and `H` are finite, then `G` is finite. -/
@[to_additive "If `ker(G →+ H)` and `H` are finite, then `G` is finite."]
noncomputable def fintypeOfKerOfCodom [Fintype g.ker] : Fintype G :=
  fintypeOfKerLeRange ((topEquiv : _ ≃* G).toMonoidHom.comp <| inclusion le_top) g fun x hx =>
    ⟨⟨x, hx⟩, rfl⟩
#align group.fintype_of_ker_of_codom Group.fintypeOfKerOfCodom
#align add_group.fintype_of_ker_of_codom AddGroup.fintypeOfKerOfCodom

/-- If `F` and `coker(F →* G)` are finite, then `G` is finite. -/
@[to_additive "If `F` and `coker(F →+ G)` are finite, then `G` is finite."]
noncomputable def fintypeOfDomOfCoker [Normal f.range] [Fintype <| G ⧸ f.range] : Fintype G :=
  fintypeOfKerLeRange _ (mk' f.range) fun x => (eq_one_iff x).mp
#align group.fintype_of_dom_of_coker Group.fintypeOfDomOfCoker
#align add_group.fintype_of_dom_of_coker AddGroup.fintypeOfDomOfCoker

end Group


/-
Copyright (c) 2014 Robert Lewis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Robert Lewis
-/
import algebra.ordered_ring algebra.field
open eq eq.ops

structure linear_ordered_field [class] (A : Type) extends linear_ordered_ring A, field A

section linear_ordered_field

  variable {A : Type}
  variables [s : linear_ordered_field A] {a b c d : A}
  include s

  -- helpers for following
  theorem mul_zero_lt_mul_inv_of_pos (H : 0 < a) : a * 0 < a * (1 / a) :=
   calc
      a * 0 = 0           : mul_zero
        ... < 1           : zero_lt_one
        ... = a * a⁻¹     : mul_inv_cancel (ne.symm (ne_of_lt H))
        ... = a * (1 / a) : inv_eq_one_div

  theorem mul_zero_lt_mul_inv_of_neg (H : a < 0) : a * 0 < a * (1 / a) :=
    calc
      a * 0 = 0           : mul_zero
        ... < 1           : zero_lt_one
        ... = a * a⁻¹     : mul_inv_cancel (ne_of_lt H)
        ... = a * (1 / a) : inv_eq_one_div

  theorem one_div_pos_of_pos (H : 0 < a) : 0 < 1 / a :=
    lt_of_mul_lt_mul_left (mul_zero_lt_mul_inv_of_pos H) (le_of_lt H)

  theorem one_div_neg_of_neg (H : a < 0) : 1 / a < 0 :=
    gt_of_mul_lt_mul_neg_left (mul_zero_lt_mul_inv_of_neg H) (le_of_lt H)

  theorem le_mul_of_ge_one_right (Hb : b ≥ 0) (H : a ≥ 1) : b ≤ b * a :=
      mul_one _ ▸ (mul_le_mul_of_nonneg_left H Hb)

  theorem lt_mul_of_gt_one_right (Hb : b > 0) (H : a > 1) : b < b * a :=
      mul_one _ ▸ (mul_lt_mul_of_pos_left H Hb)

  theorem one_le_div_iff_le (a : A) {b : A} (Hb : b > 0) : 1 ≤ a / b ↔ b ≤ a :=
    have Hb' : b ≠ 0, from ne.symm (ne_of_lt Hb),
    iff.intro
    (assume H : 1 ≤ a / b,
      calc
        b   = b           : refl
        ... ≤ b * (a / b) : le_mul_of_ge_one_right (le_of_lt Hb) H
        ... = a           : mul_div_cancel' Hb')
    (assume H : b ≤ a,
      have Hbinv : 1 / b > 0, from  one_div_pos_of_pos Hb, calc
        1  = b * (1 / b) : mul_one_div_cancel Hb'
       ... ≤ a * (1 / b) : mul_le_mul_of_nonneg_right H (le_of_lt Hbinv)
       ... = a / b       : div_eq_mul_one_div)

  theorem le_of_one_le_div (Hb : b > 0) (H : 1 ≤ a / b) : b ≤ a :=
    (iff.mp (!one_le_div_iff_le Hb)) H

  theorem one_le_div_of_le (Hb : b > 0) (H : b ≤ a) : 1 ≤ a / b :=
    (iff.mpr (!one_le_div_iff_le Hb)) H

  theorem one_lt_div_iff_lt (a : A) {b : A} (Hb : b > 0) : 1 < a / b ↔ b < a :=
    have Hb' : b ≠ 0, from ne.symm (ne_of_lt Hb),
    iff.intro
    (assume H : 1 < a / b,
      calc
        b   < b * (a / b) : lt_mul_of_gt_one_right Hb H
        ... = a           : mul_div_cancel' Hb')
    (assume H : b < a,
      have Hbinv : 1 / b > 0, from  one_div_pos_of_pos Hb, calc
        1 = b * (1 / b) : mul_one_div_cancel Hb'
      ... < a * (1 / b) : mul_lt_mul_of_pos_right H Hbinv
      ... = a / b       : div_eq_mul_one_div)

  theorem lt_of_one_lt_div (Hb : b > 0) (H : 1 < a / b) : b < a :=
    (iff.mp (!one_lt_div_iff_lt Hb)) H

  theorem one_lt_div_of_lt (Hb : b > 0) (H : b < a) : 1 < a / b :=
    (iff.mpr (!one_lt_div_iff_lt Hb)) H

  theorem exists_lt (a : A) : ∃ x, x < a :=
    have H : a - 1 < a, from add_lt_of_le_of_neg (le.refl _) zero_gt_neg_one,
    exists.intro _ H

  theorem exists_gt (a : A) : ∃ x, x > a :=
    have H : a + 1 > a, from lt_add_of_le_of_pos (le.refl _) zero_lt_one,
    exists.intro _ H

  -- the following theorems amount to four iffs, for <, ≤, ≥, >.

  theorem mul_le_of_le_div (Hc : 0 < c) (H : a ≤ b / c) : a * c ≤ b :=
    !div_mul_cancel (ne.symm (ne_of_lt Hc)) ▸ mul_le_mul_of_nonneg_right H (le_of_lt Hc)

  theorem le_div_of_mul_le (Hc : 0 < c) (H : a * c ≤ b) : a ≤ b / c :=
    calc
      a   = a * c * (1 / c) : !mul_mul_div (ne.symm (ne_of_lt Hc))
      ... ≤ b * (1 / c)     : mul_le_mul_of_nonneg_right H (le_of_lt (one_div_pos_of_pos Hc))
      ... = b / c           : div_eq_mul_one_div

  theorem mul_lt_of_lt_div (Hc : 0 < c) (H : a < b / c) : a * c < b :=
    !div_mul_cancel (ne.symm (ne_of_lt Hc)) ▸ mul_lt_mul_of_pos_right H Hc

  theorem lt_div_of_mul_lt (Hc : 0 < c) (H : a * c < b) : a < b / c :=
    calc
      a   = a * c * (1 / c) : !mul_mul_div (ne.symm (ne_of_lt Hc))
      ... < b * (1 / c)     : mul_lt_mul_of_pos_right H (one_div_pos_of_pos Hc)
      ... = b / c           : div_eq_mul_one_div

  theorem mul_le_of_div_le_of_neg (Hc : c < 0) (H : b / c ≤ a) : a * c ≤ b :=
    !div_mul_cancel (ne_of_lt Hc) ▸ mul_le_mul_of_nonpos_right H (le_of_lt Hc)

  theorem div_le_of_mul_le_of_neg (Hc : c < 0) (H : a * c ≤ b) : b / c ≤ a :=
    calc
      a   = a * c * (1 / c) : !mul_mul_div (ne_of_lt Hc)
      ... ≥ b * (1 / c)     : mul_le_mul_of_nonpos_right H (le_of_lt (one_div_neg_of_neg Hc))
      ... = b / c           : div_eq_mul_one_div

  theorem mul_lt_of_gt_div_of_neg (Hc : c < 0) (H : a > b / c) : a * c < b :=
    !div_mul_cancel (ne_of_lt Hc) ▸ mul_lt_mul_of_neg_right H Hc

  theorem div_lt_of_mul_lt_of_pos (Hc : c > 0) (H : b < a * c) : b / c < a :=
    calc
      a   = a * c * (1 / c) : !mul_mul_div (ne_of_gt Hc)
      ... > b * (1 / c)     : mul_lt_mul_of_pos_right H (one_div_pos_of_pos Hc)
      ... = b / c           : div_eq_mul_one_div

  theorem div_lt_of_mul_gt_of_neg (Hc : c < 0) (H : a * c < b) : b / c < a :=
    calc
      a   = a * c * (1 / c) : !mul_mul_div (ne_of_lt Hc)
      ... > b * (1 / c)     : mul_lt_mul_of_neg_right H (one_div_neg_of_neg Hc)
      ... = b / c           : div_eq_mul_one_div

  theorem div_le_of_le_mul (Hb : b > 0) (H : a ≤ b * c) : a / b ≤ c :=
    calc
      a / b = a * (1 / b)       : div_eq_mul_one_div
        ... ≤ (b * c) * (1 / b) : mul_le_mul_of_nonneg_right H (le_of_lt (one_div_pos_of_pos Hb))
        ... = (b * c) / b       : div_eq_mul_one_div
        ... = c                 : mul_div_cancel_left (ne.symm (ne_of_lt Hb))

  theorem le_mul_of_div_le (Hc : c > 0) (H : a / c ≤ b) : a ≤ b * c :=
    calc
      a = a / c * c : !div_mul_cancel (ne.symm (ne_of_lt Hc))
    ... ≤ b * c     : mul_le_mul_of_nonneg_right H (le_of_lt Hc)

  -- following these in the isabelle file, there are 8 biconditionals for the above with - signs
  -- skipping for now

  theorem mul_sub_mul_div_mul_neg (Hc : c ≠ 0) (Hd : d ≠ 0) (H : a / c < b / d) :
      (a * d - b * c) / (c * d) < 0 :=
    have H1 : a / c - b / d < 0, from calc
      a / c - b / d < b / d - b / d : sub_lt_sub_right H
      ... = 0 : sub_self,
    calc
      0 > a / c - b / d : H1
      ... = (a * d - c * b) / (c * d) : !div_sub_div Hc Hd
      ... = (a * d - b * c) / (c * d) : mul.comm

  theorem mul_sub_mul_div_mul_nonpos (Hc : c ≠ 0) (Hd : d ≠ 0) (H : a / c ≤ b / d) :
      (a * d - b * c) / (c * d) ≤ 0 :=
    have H1 : a / c - b / d ≤ 0, from calc
      a / c - b / d ≤ b / d - b / d : sub_le_sub_right H
      ... = 0 : sub_self,
    calc
      0 ≥ a / c - b / d : H1
      ... = (a * d - c * b) / (c * d) : !div_sub_div Hc Hd
      ... = (a * d - b * c) / (c * d) : mul.comm

  theorem div_lt_div_of_mul_sub_mul_div_neg (Hc : c ≠ 0) (Hd : d ≠ 0)
      (H : (a * d - b * c) / (c * d) < 0) : a / c < b / d :=
    have H1 : (a * d - c * b) / (c * d) < 0,     by rewrite [mul.comm c b]; exact H,
    have H2 : a / c - b / d < 0,                 by rewrite [!div_sub_div Hc Hd]; exact H1,
    have H3 : a / c - b / d + b / d < 0 + b / d, from add_lt_add_right H2 _,
    begin rewrite [zero_add at H3, sub_eq_add_neg at H3, neg_add_cancel_right at H3], exact H3 end

  theorem div_le_div_of_mul_sub_mul_div_nonpos (Hc : c ≠ 0) (Hd : d ≠ 0)
      (H : (a * d - b * c) / (c * d) ≤ 0) : a / c ≤ b / d :=
    have H1 : (a * d - c * b) / (c * d) ≤ 0,     by rewrite [mul.comm c b]; exact H,
    have H2 : a / c - b / d ≤ 0,                 by rewrite [!div_sub_div Hc Hd]; exact H1,
    have H3 : a / c - b / d + b / d ≤ 0 + b / d, from add_le_add_right H2 _,
    begin rewrite [zero_add at H3, sub_eq_add_neg at H3, neg_add_cancel_right at H3], exact H3 end

  theorem div_pos_of_pos_of_pos (Ha : 0 < a) (Hb : 0 < b) : 0 < a / b :=
    begin
      rewrite div_eq_mul_one_div,
      apply mul_pos,
      exact Ha,
      apply one_div_pos_of_pos,
      exact Hb
    end

  theorem div_nonneg_of_nonneg_of_pos (Ha : 0 ≤ a) (Hb : 0 < b) : 0 ≤ a / b :=
    begin
      rewrite div_eq_mul_one_div,
      apply mul_nonneg,
      exact Ha,
      apply le_of_lt,
      apply one_div_pos_of_pos,
      exact Hb
    end

  theorem div_neg_of_neg_of_pos (Ha : a < 0) (Hb : 0 < b) : a / b < 0:=
    begin
      rewrite div_eq_mul_one_div,
      apply mul_neg_of_neg_of_pos,
      exact Ha,
      apply one_div_pos_of_pos,
      exact Hb
    end

  theorem div_nonpos_of_nonpos_of_pos (Ha : a ≤ 0) (Hb : 0 < b) : a / b ≤ 0 :=
    begin
      rewrite div_eq_mul_one_div,
      apply mul_nonpos_of_nonpos_of_nonneg,
      exact Ha,
      apply le_of_lt,
      apply one_div_pos_of_pos,
      exact Hb
    end

  theorem div_neg_of_pos_of_neg (Ha : 0 < a) (Hb : b < 0) : a / b < 0 :=
    begin
      rewrite div_eq_mul_one_div,
      apply mul_neg_of_pos_of_neg,
      exact Ha,
      apply one_div_neg_of_neg,
      exact Hb
    end

  theorem div_nonpos_of_nonneg_of_neg (Ha : 0 ≤ a) (Hb : b < 0) :  a / b ≤ 0 :=
    begin
      rewrite div_eq_mul_one_div,
      apply mul_nonpos_of_nonneg_of_nonpos,
      exact Ha,
      apply le_of_lt,
      apply one_div_neg_of_neg,
      exact Hb
    end

  theorem div_pos_of_neg_of_neg (Ha : a < 0) (Hb : b < 0) : 0 < a / b :=
    begin
      rewrite div_eq_mul_one_div,
      apply mul_pos_of_neg_of_neg,
      exact Ha,
      apply one_div_neg_of_neg,
      exact Hb
    end

  theorem div_nonneg_of_nonpos_of_neg (Ha : a ≤ 0) (Hb : b < 0) : 0 ≤ a / b :=
    begin
      rewrite div_eq_mul_one_div,
      apply mul_nonneg_of_nonpos_of_nonpos,
      exact Ha,
      apply le_of_lt,
      apply one_div_neg_of_neg,
      exact Hb
    end

  theorem div_lt_div_of_lt_of_pos (H : a < b) (Hc : 0 < c) : a / c < b / c :=
  begin
    rewrite [{a/c}div_eq_mul_one_div, {b/c}div_eq_mul_one_div],
    exact mul_lt_mul_of_pos_right H (one_div_pos_of_pos Hc)
  end

  theorem div_le_div_of_le_of_pos (H : a ≤ b) (Hc : 0 < c) : a / c ≤ b / c :=
    begin
      rewrite [{a/c}div_eq_mul_one_div, {b/c}div_eq_mul_one_div],
      exact mul_le_mul_of_nonneg_right H (le_of_lt (one_div_pos_of_pos Hc))
    end

  theorem div_lt_div_of_lt_of_neg (H : b < a) (Hc : c < 0) : a / c < b / c :=
  begin
    rewrite [{a/c}div_eq_mul_one_div, {b/c}div_eq_mul_one_div],
    exact mul_lt_mul_of_neg_right H (one_div_neg_of_neg Hc)
  end

  theorem div_le_div_of_le_of_neg (H : b ≤ a) (Hc : c < 0) : a / c ≤ b / c :=
  begin
    rewrite [{a/c}div_eq_mul_one_div, {b/c}div_eq_mul_one_div],
    exact mul_le_mul_of_nonpos_right H (le_of_lt (one_div_neg_of_neg Hc))
  end

  theorem two_pos : (1 : A) + 1 > 0 :=
    add_pos zero_lt_one zero_lt_one

  theorem one_add_one_ne_zero : 1 + 1 ≠ (0:A) :=
  ne.symm (ne_of_lt two_pos)

  theorem two_ne_zero : 2 ≠ (0:A) :=
  by unfold bit0; apply one_add_one_ne_zero

  theorem add_halves (a : A) : a / 2 + a / 2 = a :=
    calc
      a / 2 + a / 2 = (a + a) / 2 : by rewrite div_add_div_same
      ... = (a * 1 + a * 1) / 2   : by rewrite mul_one
      ... = (a * (1 + 1)) / 2     : by rewrite left_distrib
      ... = (a * 2) / 2           : by rewrite one_add_one_eq_two
      ... = a                     : by rewrite [@mul_div_cancel A _ _ _ two_ne_zero]

  theorem sub_self_div_two (a : A) : a - a / 2 = a / 2 :=
    by rewrite [-{a}add_halves at {1}, add_sub_cancel]

  theorem add_midpoint {a b : A} (H : a < b) : a + (b - a) / 2 < b :=
  begin
    rewrite [-div_sub_div_same, sub_eq_add_neg, {b / 2 + _}add.comm, -add.assoc, -sub_eq_add_neg],
    apply add_lt_of_lt_sub_right,
    rewrite *sub_self_div_two,
    apply div_lt_div_of_lt_of_pos H two_pos
  end

  theorem div_two_sub_self (a : A) : a / 2 - a = - (a / 2) :=
  by rewrite [-{a}add_halves at {2}, sub_add_eq_sub_sub, sub_self, zero_sub]

  theorem add_self_div_two (a : A) : (a + a) / 2 = a :=
  symm (iff.mpr (!eq_div_iff_mul_eq (ne_of_gt (add_pos zero_lt_one zero_lt_one)))
       (by krewrite [left_distrib, *mul_one]))

  theorem two_gt_one : (2:A) > 1 :=
  calc (2:A) = 1+1 : one_add_one_eq_two
       ...   > 1+0 : add_lt_add_left zero_lt_one
       ...   = 1   : add_zero

  theorem two_ge_one : (2:A) ≥ 1 :=
  le_of_lt two_gt_one

  theorem four_pos : (4 : A) > 0 := add_pos two_pos two_pos

  theorem mul_le_mul_of_mul_div_le (H : a * (b / c) ≤ d) (Hc : c > 0) : b * a ≤ d * c :=
  begin
    rewrite [-mul_div_assoc at H, mul.comm b],
    apply le_mul_of_div_le Hc H
  end

  theorem div_two_lt_of_pos (H : a > 0) : a / (1 + 1) < a :=
  have Ha : a / (1 + 1) > 0, from div_pos_of_pos_of_pos H (add_pos zero_lt_one zero_lt_one),
  calc
      a / (1 + 1) < a / (1 + 1) + a / (1 + 1) : lt_add_of_pos_left Ha
              ... = a : add_halves

  theorem div_mul_le_div_mul_of_div_le_div_pos {e : A} (Hb : b ≠ 0) (Hd : d ≠ 0) (H : a / b ≤ c / d)
          (He : e > 0) : a / (b * e) ≤ c / (d * e) :=
    begin
      rewrite [!field.div_mul_eq_div_mul_one_div Hb (ne_of_gt He),
               !field.div_mul_eq_div_mul_one_div Hd (ne_of_gt He)],
      apply mul_le_mul_of_nonneg_right H,
      apply le_of_lt,
      apply one_div_pos_of_pos He
    end

  theorem exists_add_lt_and_pos_of_lt (H : b < a) : ∃ c : A, b + c < a ∧ c > 0 :=
  exists.intro ((a - b) / (1 + 1))
      (and.intro (have H2 : a + a > (b + b) + (a - b), from calc
        a + a > b + a : add_lt_add_right H
        ... = b + a + b - b : add_sub_cancel
        ... = b + b + a - b : add.right_comm
        ... = (b + b) + (a - b) : add_sub,
      have H3 : (a + a) / 2 > ((b + b) + (a - b)) / 2,
        from div_lt_div_of_lt_of_pos H2 two_pos,
      by rewrite [one_add_one_eq_two, sub_eq_add_neg, add_self_div_two at H3, -div_add_div_same at H3, add_self_div_two at H3];
           exact H3)
      (div_pos_of_pos_of_pos (iff.mpr !sub_pos_iff_lt H) two_pos))

  theorem ge_of_forall_ge_sub {a b : A} (H : ∀ ε : A, ε > 0 → a ≥ b - ε) : a ≥ b :=
  begin
    apply le_of_not_gt,
    intro Hb,
    cases exists_add_lt_and_pos_of_lt Hb with [c, Hc],
    let Hc' := H c (and.right Hc),
    apply (not_le_of_gt (and.left Hc)) (iff.mpr !le_add_iff_sub_right_le Hc')
  end

theorem mul_div_self_add_lt {b c d : A} (Hb : b > 0) (Hc : c > 0) (Hd : d > 0) : c * (b / (c + d)) < b :=
  begin
    rewrite -mul_div_assoc,
    apply div_lt_of_mul_lt_of_pos,
    apply add_pos,
    repeat assumption,
    rewrite mul.comm,
    apply mul_lt_mul_of_pos_left,
    apply lt_add_of_pos_right,
    repeat assumption
  end

theorem mul_div_add_self_lt {b c d : A} (Hb : b > 0) (Hc : c > 0) (Hd : d > 0) : d * (b / (c + d)) < b :=
  by rewrite add.comm; apply mul_div_self_add_lt; repeat assumption

end linear_ordered_field

structure discrete_linear_ordered_field [class] (A : Type) extends linear_ordered_field A,
  decidable_linear_ordered_comm_ring A :=
  (inv_zero : inv zero = zero)

section discrete_linear_ordered_field

  variable {A : Type}
  variables [s : discrete_linear_ordered_field A] {a b c : A}
  include s

  definition dec_eq_of_dec_lt : ∀ x y : A, decidable (x = y) :=
    take x y,
    decidable.by_cases
    (assume H : x < y, decidable.inr (ne_of_lt H))
    (assume H : ¬ x < y,
      decidable.by_cases
      (assume H' : y < x, decidable.inr (ne.symm (ne_of_lt H')))
      (assume H' : ¬ y < x,
        decidable.inl (le.antisymm (le_of_not_gt H') (le_of_not_gt H))))

  definition discrete_linear_ordered_field.to_discrete_field [trans_instance] :  discrete_field A :=
     ⦃ discrete_field, s, has_decidable_eq := dec_eq_of_dec_lt⦄

    theorem pos_of_one_div_pos (H : 0 < 1 / a) : 0 < a :=
    have H1 : 0 < 1 / (1 / a), from one_div_pos_of_pos H,
    have H2 : 1 / a ≠ 0, from
      (assume H3 : 1 / a = 0,
      have H4 : 1 / (1 / a) = 0, from H3⁻¹ ▸ !div_zero,
      absurd H4 (ne.symm (ne_of_lt H1))),
    (division_ring.one_div_one_div (ne_zero_of_one_div_ne_zero H2)) ▸ H1

  theorem neg_of_one_div_neg (H : 1 / a < 0) : a < 0 :=
    have H1 : 0 < - (1 / a), from neg_pos_of_neg H,
    have Ha : a ≠ 0, from ne_zero_of_one_div_ne_zero (ne_of_lt H),
    have H2 : 0 < 1 / (-a), from (division_ring.one_div_neg_eq_neg_one_div Ha)⁻¹ ▸ H1,
    have H3 : 0 < -a, from pos_of_one_div_pos H2,
    neg_of_neg_pos H3

  theorem le_of_one_div_le_one_div (H : 0 < a) (Hl : 1 / a ≤ 1 / b) : b ≤ a :=
    have Hb : 0 < b, from pos_of_one_div_pos (calc
      0   < 1 / a : one_div_pos_of_pos H
      ... ≤ 1 / b : Hl),
    have H' : 1 ≤ a / b, from (calc
      1   = a / a       : div_self (ne.symm (ne_of_lt H))
      ... = a * (1 / a) :  div_eq_mul_one_div
      ... ≤ a * (1 / b) : mul_le_mul_of_nonneg_left Hl (le_of_lt H)
      ... = a / b       : div_eq_mul_one_div
      ), le_of_one_le_div Hb H'

  theorem le_of_one_div_le_one_div_of_neg (H : b < 0) (Hl : 1 / a ≤ 1 / b) : b ≤ a :=
    have Ha : a ≠ 0, from ne_of_lt (neg_of_one_div_neg (calc
      1 / a ≤ 1 / b : Hl
        ... < 0     : one_div_neg_of_neg H)),
    have H'   : -b > 0,                from neg_pos_of_neg H,
    have Hl'  : - (1 / b) ≤ - (1 / a), from neg_le_neg Hl,
    have Hl'' : 1 / - b ≤ 1 / - a,     from calc
      1 / -b = - (1 / b) : by rewrite [division_ring.one_div_neg_eq_neg_one_div (ne_of_lt H)]
         ... ≤ - (1 / a) : Hl'
         ... = 1 / -a    : by rewrite [division_ring.one_div_neg_eq_neg_one_div Ha],
    le_of_neg_le_neg (le_of_one_div_le_one_div H' Hl'')

  theorem lt_of_one_div_lt_one_div (H : 0 < a) (Hl : 1 / a < 1 / b) : b < a :=
    have Hb : 0 < b, from pos_of_one_div_pos (calc
      0   < 1 / a : one_div_pos_of_pos H
      ... < 1 / b : Hl),
    have H : 1 < a / b, from (calc
      1   = a / a       : div_self (ne.symm (ne_of_lt H))
      ... = a * (1 / a) : div_eq_mul_one_div
      ... < a * (1 / b) : mul_lt_mul_of_pos_left Hl H
      ... = a / b       : div_eq_mul_one_div),
      lt_of_one_lt_div Hb H

  theorem lt_of_one_div_lt_one_div_of_neg (H : b < 0) (Hl : 1 / a < 1 / b) : b < a :=
    have H1 : b ≤ a, from le_of_one_div_le_one_div_of_neg H (le_of_lt Hl),
    have Hn : b ≠ a, from
      (assume Hn' : b = a,
      have Hl' : 1 / a = 1 / b, from Hn' ▸ refl _,
      absurd Hl' (ne_of_lt Hl)),
    lt_of_le_of_ne H1 Hn

  theorem one_div_lt_one_div_of_lt (Ha : 0 < a) (H : a < b) : 1 / b < 1 / a :=
    lt_of_not_ge
      (assume H',
      absurd H (not_lt_of_ge (le_of_one_div_le_one_div Ha H')))

  theorem one_div_le_one_div_of_le (Ha : 0 < a) (H : a ≤ b) : 1 / b ≤ 1 / a :=
    le_of_not_gt
      (assume H',
      absurd H (not_le_of_gt (lt_of_one_div_lt_one_div Ha H')))

  theorem one_div_lt_one_div_of_lt_of_neg (Hb : b < 0) (H : a < b) : 1 / b < 1 / a :=
    lt_of_not_ge
      (assume H',
      absurd H (not_lt_of_ge (le_of_one_div_le_one_div_of_neg Hb H')))

  theorem one_div_le_one_div_of_le_of_neg (Hb : b < 0) (H : a ≤ b) : 1 / b ≤ 1 / a :=
    le_of_not_gt
      (assume H',
      absurd H (not_le_of_gt (lt_of_one_div_lt_one_div_of_neg Hb H')))

  theorem one_div_le_of_one_div_le_of_pos (Ha : a > 0) (H : 1 / a ≤ b) : 1 / b ≤ a :=
    begin
      rewrite -(one_div_one_div a),
      apply one_div_le_one_div_of_le,
      apply one_div_pos_of_pos,
      repeat assumption
    end

  theorem one_div_le_of_one_div_le_of_neg (Ha : b < 0) (H : 1 / a ≤ b) : 1 / b ≤ a :=
    begin
      rewrite -(one_div_one_div a),
      apply one_div_le_one_div_of_le_of_neg,
      repeat assumption
    end

  theorem one_lt_one_div (H1 : 0 < a) (H2 : a < 1) : 1 < 1 / a :=
    one_div_one ▸ one_div_lt_one_div_of_lt H1 H2

  theorem one_le_one_div (H1 : 0 < a) (H2 : a ≤ 1) : 1 ≤ 1 / a :=
    one_div_one ▸ one_div_le_one_div_of_le H1 H2

  theorem one_div_lt_neg_one (H1 : a < 0) (H2 : -1 < a) : 1 / a < -1 :=
    one_div_neg_one_eq_neg_one ▸ one_div_lt_one_div_of_lt_of_neg H1 H2

  theorem one_div_le_neg_one (H1 : a < 0) (H2 : -1 ≤ a) : 1 / a ≤ -1 :=
    one_div_neg_one_eq_neg_one ▸ one_div_le_one_div_of_le_of_neg H1 H2

  theorem div_lt_div_of_pos_of_lt_of_pos (Hb : 0 < b) (H : b < a) (Hc : 0 < c) : c / a < c / b :=
    begin
      apply iff.mp !sub_neg_iff_lt,
      rewrite [div_eq_mul_one_div, {c / b}div_eq_mul_one_div, -mul_sub_left_distrib],
      apply mul_neg_of_pos_of_neg,
      exact Hc,
      apply iff.mpr !sub_neg_iff_lt,
      apply one_div_lt_one_div_of_lt,
      repeat assumption
    end

  theorem div_mul_le_div_mul_of_div_le_div_pos' {d e : A} (H : a / b ≤ c / d)
          (He : e > 0) : a / (b * e) ≤ c / (d * e) :=
    begin
      rewrite [2 div_mul_eq_div_mul_one_div],
      apply mul_le_mul_of_nonneg_right H,
      apply le_of_lt,
      apply one_div_pos_of_pos He
    end

  theorem abs_div (a b : A) : abs (a / b) = abs a / abs b :=
  decidable.by_cases
    (suppose b = 0, by rewrite [this, abs_zero, *div_zero, abs_zero])
    (suppose b ≠ 0,
      have abs b ≠ 0, from assume H, this (eq_zero_of_abs_eq_zero H),
      eq_div_of_mul_eq _ _ this
        (show abs (a / b) * abs b = abs a, by rewrite [-abs_mul, div_mul_cancel _ `b ≠ 0`]))

  theorem abs_one_div (a : A) : abs (1 / a) = 1 / abs a :=
  by rewrite [abs_div, abs_of_nonneg (zero_le_one : 1 ≥ (0 : A))]

  theorem sign_eq_div_abs (a : A) : sign a = a / (abs a) :=
  decidable.by_cases
    (suppose a = 0, by subst a; rewrite [zero_div, sign_zero])
    (suppose a ≠ 0,
      have abs a ≠ 0, from assume H, this (eq_zero_of_abs_eq_zero H),
      !eq_div_of_mul_eq this !eq_sign_mul_abs⁻¹)

  theorem add_quarters (a : A) : a / 4 + a / 4 = a / 2 :=
    have H4 : (4 : A) = 2 * 2, by norm_num,
    calc
      a / 4 + a / 4 = (a + a) / (2 * 2)         : by rewrite [-H4, div_add_div_same]
                ... = (a * 1 + a * 1) / (2 * 2) : by rewrite mul_one
                ... = (a * (1 + 1)) / (2 * 2)   : by rewrite left_distrib
                ... = (a * 2) / (2 * 2)         : rfl
                ... = ((a * 2) / 2) / 2         : by rewrite -div_div_eq_div_mul
                ... = a / 2                     : by rewrite (mul_div_cancel a two_ne_zero)

  lemma div_two_add_div_four_lt {a : A} (H : a > 0) : a / 2 + a / 4 < a :=
  begin
    replace (4 : A) with (2 : A) + 2,
    have Hne : (2 + 2 : A) ≠ 0, from ne_of_gt four_pos,
    krewrite (div_add_div _ _ two_ne_zero Hne),
    have Hnum : (2 + 2 + 2) / (2 * (2 + 2)) = (3 : A) / 4, by norm_num,
    rewrite [{2 * a}mul.comm, -left_distrib, mul_div_assoc, -mul_one a at {2}], krewrite Hnum,
    apply mul_lt_mul_of_pos_left,
    apply div_lt_of_mul_lt_of_pos,
    apply four_pos,
    rewrite one_mul,
    replace (3 : A) with (2 : A) + 1,
    replace (4 : A) with (2 : A) + 2,
    apply add_lt_add_left,
    apply two_gt_one,
    exact H
  end

  theorem div_nonneg_of_nonneg_of_nonneg {a b : A} (Ha : a ≥ 0) (Hb : b ≥ 0) : a / b ≥ 0 :=
    if Hgt : b > 0 then
      div_nonneg_of_nonneg_of_pos Ha Hgt
    else
      have b = 0, from eq_of_le_of_ge (le_of_not_gt Hgt) Hb,
      by rewrite [this, div_zero]; apply le.refl

  theorem div_le_div_of_le_of_nonneg (H : a ≤ b) (Hc : 0 ≤ c) : a / c ≤ b / c :=
    begin
      cases lt_or_eq_of_le Hc with Hlt Heq,
      apply div_le_div_of_le_of_pos H Hlt,
      rewrite [-Heq, 2 div_zero]
    end

  theorem div_le_div_of_le_of_nonpos (H : b ≤ a) (Hc : c ≤ 0) : a / c ≤ b / c :=
    begin
      cases lt_or_eq_of_le Hc with Hlt Heq,
      apply div_le_div_of_le_of_neg H Hlt,
      rewrite [Heq, 2 div_zero]
    end

end discrete_linear_ordered_field


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

Instantiates the reals as a Banach space.
-/
import .metric_space data.real.complete data.set .normed_space
open real classical analysis nat topology
noncomputable theory

/- sup and inf -/

-- Expresses completeness, sup, and inf in a manner that is less constructive, but more convenient,
-- than the way it is done in data.real.complete.

-- Issue: real.sup and real.inf conflict with sup and inf in lattice.
-- Perhaps put algebra sup and inf into a namespace?

namespace real
open set

private definition exists_is_sup {X : set ℝ} (H : (∃ x, x ∈ X) ∧ (∃ b, ∀ x, x ∈ X → x ≤ b)) :
  ∃ y, is_sup X y :=
let x := some (and.left H), b := some (and.right H) in
  exists_is_sup_of_inh_of_bdd X x (some_spec (and.left H)) b (some_spec (and.right H))

private definition sup_aux {X : set ℝ} (H : (∃ x, x ∈ X) ∧ (∃ b, ∀ x, x ∈ X → x ≤ b)) :=
some (exists_is_sup H)

private definition sup_aux_spec {X : set ℝ} (H : (∃ x, x ∈ X) ∧ (∃ b, ∀ x, x ∈ X → x ≤ b)) :
  is_sup X (sup_aux H) :=
some_spec (exists_is_sup H)

definition sup (X : set ℝ) : ℝ :=
if H : (∃ x, x ∈ X) ∧ (∃ b, ∀ x, x ∈ X → x ≤ b) then sup_aux H else 0

proposition le_sup {x : ℝ} {X : set ℝ} (Hx : x ∈ X) {b : ℝ} (Hb : ∀ x, x ∈ X → x ≤ b) :
  x ≤ sup X :=
have H : (∃ x, x ∈ X) ∧ (∃ b, ∀ x, x ∈ X → x ≤ b),
  from and.intro (exists.intro x Hx) (exists.intro b Hb),
by rewrite [↑sup, dif_pos H]; exact and.left (sup_aux_spec H) x Hx

proposition sup_le {X : set ℝ} (HX : ∃ x, x ∈ X) {b : ℝ} (Hb : ∀ x, x ∈ X → x ≤ b) :
  sup X ≤ b :=
have H : (∃ x, x ∈ X) ∧ (∃ b, ∀ x, x ∈ X → x ≤ b),
  from and.intro HX (exists.intro b Hb),
by rewrite [↑sup, dif_pos H]; exact and.right (sup_aux_spec H) b Hb

proposition exists_mem_and_lt_of_lt_sup {X : set ℝ} (HX : ∃ x, x ∈ X) {b : ℝ} (Hb : b < sup X) :
∃ x, x ∈ X ∧ b < x :=
have ¬ ∀ x, x ∈ X → x ≤ b, from assume H, not_le_of_gt Hb (sup_le HX H),
obtain x (Hx : ¬ (x ∈ X → x ≤ b)), from exists_not_of_not_forall this,
exists.intro x
  (have x ∈ X ∧ ¬ x ≤ b, by rewrite [-not_implies_iff_and_not]; apply Hx,
     and.intro (and.left this) (lt_of_not_ge (and.right this)))

private definition exists_is_inf {X : set ℝ} (H : (∃ x, x ∈ X) ∧ (∃ b, ∀ x, x ∈ X → b ≤ x)) :
  ∃ y, is_inf X y :=
let x := some (and.left H), b := some (and.right H) in
  exists_is_inf_of_inh_of_bdd X x (some_spec (and.left H)) b (some_spec (and.right H))

private definition inf_aux {X : set ℝ} (H : (∃ x, x ∈ X) ∧ (∃ b, ∀ x, x ∈ X → b ≤ x)) :=
some (exists_is_inf H)

private definition inf_aux_spec {X : set ℝ} (H : (∃ x, x ∈ X) ∧ (∃ b, ∀ x, x ∈ X → b ≤ x)) :
  is_inf X (inf_aux H) :=
some_spec (exists_is_inf H)

definition inf (X : set ℝ) : ℝ :=
if H : (∃ x, x ∈ X) ∧ (∃ b, ∀ x, x ∈ X → b ≤ x) then inf_aux H else 0

proposition inf_le {x : ℝ} {X : set ℝ} (Hx : x ∈ X) {b : ℝ} (Hb : ∀ x, x ∈ X → b ≤ x) :
  inf X ≤ x :=
have H : (∃ x, x ∈ X) ∧ (∃ b, ∀ x, x ∈ X → b ≤ x),
  from and.intro (exists.intro x Hx) (exists.intro b Hb),
by rewrite [↑inf, dif_pos H]; exact and.left (inf_aux_spec H) x Hx

proposition le_inf {X : set ℝ} (HX : ∃ x, x ∈ X) {b : ℝ} (Hb : ∀ x, x ∈ X → b ≤ x) :
  b ≤ inf X :=
have H : (∃ x, x ∈ X) ∧ (∃ b, ∀ x, x ∈ X → b ≤ x),
  from and.intro HX (exists.intro b Hb),
by rewrite [↑inf, dif_pos H]; exact and.right (inf_aux_spec H) b Hb

proposition exists_mem_and_lt_of_inf_lt {X : set ℝ} (HX : ∃ x, x ∈ X) {b : ℝ} (Hb : inf X < b) :
∃ x, x ∈ X ∧ x < b :=
have ¬ ∀ x, x ∈ X → b ≤ x, from assume H, not_le_of_gt Hb (le_inf HX H),
obtain x (Hx : ¬ (x ∈ X → b ≤ x)), from exists_not_of_not_forall this,
exists.intro x
  (have x ∈ X ∧ ¬ b ≤ x, by rewrite [-not_implies_iff_and_not]; apply Hx,
     and.intro (and.left this) (lt_of_not_ge (and.right this)))

section
local attribute mem [reducible]
-- TODO: is there a better place to put this?
proposition image_neg_eq (X : set ℝ) : (λ x, -x) ' X = {x | -x ∈ X} :=
set.ext (take x, iff.intro
  (assume H, obtain y [(Hy₁ : y ∈ X) (Hy₂ : -y = x)], from H,
    show -x ∈ X, by rewrite [-Hy₂, neg_neg]; exact Hy₁)
  (assume H : -x ∈ X, exists.intro (-x) (and.intro H !neg_neg)))

proposition sup_neg {X : set ℝ} (nonempty_X : ∃ x, x ∈ X) {b : ℝ} (Hb : ∀ x, x ∈ X → b ≤ x) :
  sup {x | -x ∈ X} = - inf X :=
let negX := {x | -x ∈ X} in
have nonempty_negX : ∃ x, x ∈ negX, from
  obtain x Hx, from nonempty_X,
  have -(-x) ∈ X,
    by rewrite neg_neg; apply Hx,
  exists.intro (-x) this,
have H₁ : ∀ x, x ∈ negX → x ≤ - inf X, from
  take x,
  assume H,
  have inf X ≤ -x,
    from inf_le H Hb,
  show x ≤ - inf X,
    from le_neg_of_le_neg this,
have H₂ : ∀ x, x ∈ X → -sup negX ≤ x, from
  take x,
  assume H,
  have -(-x) ∈ X, by rewrite neg_neg; apply H,
  have -x ≤ sup negX, from le_sup this H₁,
  show -sup negX ≤ x,
    from !neg_le_of_neg_le this,
eq_of_le_of_ge
  (show sup negX ≤ - inf X,
    from sup_le nonempty_negX H₁)
  (show -inf X ≤ sup negX,
    from !neg_le_of_neg_le (le_inf nonempty_X H₂))

proposition inf_neg {X : set ℝ} (nonempty_X : ∃ x, x ∈ X) {b : ℝ} (Hb : ∀ x, x ∈ X → x ≤ b) :
  inf {x | -x ∈ X} = - sup X :=
let negX := {x | -x ∈ X} in
have nonempty_negX : ∃ x, x ∈ negX, from
  obtain x Hx, from nonempty_X,
  have -(-x) ∈ X,
    by rewrite neg_neg; apply Hx,
  exists.intro (-x) this,
have Hb' : ∀ x, x ∈ negX → -b ≤ x,
  from take x, assume H, !neg_le_of_neg_le (Hb _ H),
have HX : X = {x | -x ∈ negX},
  from set.ext (take x, by rewrite [↑set_of, ↑mem, +neg_neg]),
show inf {x | -x ∈ X} = - sup X,
  by rewrite [HX at {2}, sup_neg nonempty_negX Hb', neg_neg]
end
end real

/- the reals form a complete metric space -/

namespace real
proposition approaches_at_infty_intro {X : ℕ → ℝ} {y : ℝ}
    (H : ∀ ⦃ε : ℝ⦄, ε > 0 → ∃ N : ℕ, ∀ {n}, n ≥ N → abs (X n - y) < ε) :
  (X ⟶ y [at ∞]) := metric_space.approaches_at_infty_intro H

proposition approaches_at_infty_dest {X : ℕ → ℝ} {y : ℝ} (H : X ⟶ y [at ∞]) :
    ∀ ⦃ε : ℝ⦄, ε > 0 → ∃ N : ℕ, ∀ {n}, n ≥ N → abs (X n - y) < ε := metric_space.approaches_at_infty_dest H

proposition approaches_at_infty_intro' {X : ℕ → ℝ} {y : ℝ}
    (H : ∀ ⦃ε : ℝ⦄, ε > 0 → ∃ N : ℕ, ∀ {n}, n ≥ N → abs (X n - y) ≤ ε) :
  (X ⟶ y [at ∞]) :=
approaches_at_infty_intro' H
end real

namespace analysis

theorem dist_eq_abs (x y : real) : dist x y = abs (x - y) := rfl

open pnat subtype
local postfix ⁻¹ := pnat.inv

private definition pnat.succ (n : ℕ) : ℕ+ := tag (succ n) !succ_pos

private definition r_seq_of (X : ℕ → ℝ) : r_seq := λ n, X (elt_of n)

private lemma rate_of_cauchy_aux {X : ℕ → ℝ} (H : cauchy X) :
  ∀ k : ℕ+, ∃ N : ℕ+, ∀ m n : ℕ+,
    m ≥ N → n ≥ N → abs (X (elt_of m) - X (elt_of n)) ≤ of_rat k⁻¹ :=
take k : ℕ+,
have H1 : (k⁻¹ >[rat] (rat.of_num 0)), from !pnat.inv_pos,
have H2 : (of_rat k⁻¹ > of_rat (rat.of_num 0)), from !of_rat_lt_of_rat_of_lt H1,
obtain (N : ℕ) (H : ∀ m n, m ≥ N → n ≥ N → abs (X m - X n) < of_rat k⁻¹), from H _ H2,
exists.intro (pnat.succ N)
  (take m n : ℕ+,
    assume Hm : m ≥ (pnat.succ N),
    assume Hn : n ≥ (pnat.succ N),
    have Hm' : elt_of m ≥ N, begin apply le.trans, apply le_succ, apply Hm end,
    have Hn' : elt_of n ≥ N, begin apply le.trans, apply le_succ, apply Hn end,
    show abs (X (elt_of m) - X (elt_of n)) ≤ of_rat k⁻¹, from le_of_lt (H _ _ Hm' Hn'))

private definition rate_of_cauchy {X : ℕ → ℝ} (H : cauchy X) (k : ℕ+) : ℕ+ :=
some (rate_of_cauchy_aux H k)

private lemma cauchy_with_rate_of_cauchy {X : ℕ → ℝ} (H : cauchy X) :
  cauchy_with_rate (r_seq_of X) (rate_of_cauchy H) :=
take k : ℕ+,
some_spec (rate_of_cauchy_aux H k)

private lemma converges_to_with_rate_of_cauchy {X : ℕ → ℝ} (H : cauchy X) :
  ∃ l Nb, converges_to_with_rate (r_seq_of X) l Nb :=
begin
  apply exists.intro,
  apply exists.intro,
  apply converges_to_with_rate_of_cauchy_with_rate,
  exact cauchy_with_rate_of_cauchy H
end

theorem converges_seq_of_cauchy {X : ℕ → ℝ} (H : cauchy X) : converges_seq X :=
obtain l Nb (conv : converges_to_with_rate (r_seq_of X) l Nb),
  from converges_to_with_rate_of_cauchy H,
exists.intro l
  (real.approaches_at_infty_intro
    take ε : ℝ,
    suppose ε > 0,
    obtain (k' : ℕ) (Hn : 1 / succ k' < ε), from archimedean_small `ε > 0`,
    let k : ℕ+ := tag (succ k') !succ_pos,
        N : ℕ+ := Nb k in
    have Hk : real.of_rat k⁻¹ < ε,
      by rewrite [↑pnat.inv, of_rat_divide]; exact Hn,
    exists.intro (elt_of N)
      (take n : ℕ,
        assume Hn : n ≥ elt_of N,
        let n' : ℕ+ := tag n (nat.lt_of_lt_of_le (has_property N) Hn) in
        have abs (X n - l) ≤ real.of_rat k⁻¹, by apply conv k n' Hn,
        show abs (X n - l) < ε, from lt_of_le_of_lt this Hk))

end analysis

definition complete_metric_space_real [trans_instance] :
  complete_metric_space ℝ :=
⦃complete_metric_space, metric_space_real,
  complete := @analysis.converges_seq_of_cauchy
⦄

/- the real numbers can be viewed as a banach space -/

definition real_vector_space_real : real_vector_space ℝ :=
⦃ real_vector_space, real.discrete_linear_ordered_field,
  smul               := mul,
  smul_left_distrib  := left_distrib,
  smul_right_distrib := right_distrib,
  mul_smul           := mul.assoc,
  one_smul           := one_mul
⦄

definition banach_space_real [trans_instance] : banach_space ℝ :=
⦃ banach_space, real_vector_space_real,
  norm                    := abs,
  norm_zero               := abs_zero,
  eq_zero_of_norm_eq_zero := λ a H, eq_zero_of_abs_eq_zero H,
  norm_triangle           := abs_add_le_abs_add_abs,
  norm_smul               := abs_mul,
  complete                := λ X H, analysis.complete ℝ H
⦄

namespace real
open topology set
open normed_vector_space

section
variable {f : ℝ → ℝ}

theorem continuous_dest (H : continuous f) :
  ∀ x : ℝ, ∀ ⦃ε : ℝ⦄, ε > 0 → ∃ δ : ℝ, δ > 0 ∧ ∀ x' : ℝ,
    abs (x' - x) < δ → abs (f x' - f x) < ε :=
normed_vector_space.continuous_dest H

theorem continuous_intro
  (H : ∀ x : ℝ, ∀ ⦃ε : ℝ⦄, ε > 0 → ∃ δ : ℝ, δ > 0 ∧ ∀ x' : ℝ,
    abs (x' - x) < δ → abs (f x' - f x) < ε) :
  continuous f :=
normed_vector_space.continuous_intro H

theorem continuous_at_dest {x : ℝ} (H : continuous_at f x) :
         ∀ ε : ℝ, ε > 0 → (∃ δ : ℝ, δ > 0 ∧ ∀ x' : ℝ, abs (x' - x) < δ → abs (f x' - f x) < ε) :=
normed_vector_space.continuous_at_dest H

theorem continuous_at_intro {x : ℝ}
  (H : ∀ ⦃ε : ℝ⦄, ε > 0 → ∃ δ : ℝ, δ > 0 ∧ ∀ x' : ℝ,
    abs (x' - x) < δ → abs (f x' - f x) < ε) :
  continuous_at f x :=
normed_vector_space.continuous_at_intro H

theorem continuous_at_within_intro {x : ℝ} {s : set ℝ}
        (H : ∀ ⦃ε⦄, ε > 0 → ∃ δ, δ > 0 ∧ ∀ ⦃x'⦄, x' ∈ s → abs (x' - x) < δ → abs ((f x') - (f x)) < ε) :
  continuous_at_on f x s :=
normed_vector_space.continuous_at_within_intro H

theorem continuous_at_on_dest {x : ℝ} {s : set ℝ} (Hfx : continuous_at_on f x s) :
         ∀ ⦃ε⦄, ε > 0 → ∃ δ, δ > 0 ∧ ∀ ⦃x'⦄, x' ∈ s → abs (x' - x) < δ → abs ((f x') - (f x)) < ε :=
normed_vector_space.continuous_at_on_dest Hfx

theorem continuous_on_intro {s : set ℝ}
        (H : ∀ x ⦃ε⦄, ε > 0 → ∃ δ, δ > 0 ∧ ∀ ⦃x'⦄, x' ∈ s → abs (x' - x) < δ → abs ((f x') - (f x)) < ε) :
        continuous_on f s :=
normed_vector_space.continuous_on_intro H

theorem continuous_on_dest {s : set ℝ} (H : continuous_on f s) {x : ℝ} (Hxs : x ∈ s) :
        ∀ ⦃ε⦄, ε > 0 → ∃ δ, δ > 0 ∧ ∀ ⦃x'⦄, x' ∈ s → abs (x' - x) < δ → abs ((f x') - (f x)) < ε :=
normed_vector_space.continuous_on_dest H Hxs

end

section approaches
open set.filter set topology
  variables {X : Type} {F : filter X} {f : X → ℝ} {y : ℝ}

  proposition approaches_intro (H : ∀ ε, ε > 0 → eventually (λ x, abs ((f x) - y) < ε) F) :
    (f ⟶ y) F :=
  normed_vector_space.approaches_intro H

  proposition approaches_dest (H : (f ⟶ y) F) {ε : ℝ} (εpos : ε > 0) :
    eventually (λ x, abs ((f x) - y) < ε) F :=
  normed_vector_space.approaches_dest H εpos

  variables (F f y)

  proposition approaches_iff : ((f ⟶ y) F) ↔ (∀ ε, ε > 0 → eventually (λ x, abs ((f x) - y) < ε) F) :=
  iff.intro approaches_dest approaches_intro

end approaches

section
variable {f : ℝ → ℝ}
proposition approaches_at_dest  {y x : ℝ}
    (H : f ⟶ y [at x]) ⦃ε : ℝ⦄ (εpos : ε > 0) :
  ∃ δ, δ > 0 ∧ ∀ ⦃x'⦄, abs (x' - x) < δ → x' ≠ x → abs ((f x') - y) < ε :=
metric_space.approaches_at_dest H εpos

proposition approaches_at_intro {y x : ℝ}
    (H : ∀ ε, ε > 0 → ∃ δ, δ > 0 ∧ ∀ ⦃x'⦄, abs (x' - x) < δ → x' ≠ x → abs ((f x') - y) < ε) :
  f ⟶ y [at x] :=
metric_space.approaches_at_intro H

proposition approaches_at_iff (y x : ℝ) : f ⟶ y [at x] ↔
    (∀ ⦃ε⦄, ε > 0 → ∃ δ, δ > 0 ∧ ∀ ⦃x'⦄, abs (x' - x) < δ → x' ≠ x → abs ((f x') - y) < ε) :=
iff.intro approaches_at_dest approaches_at_intro

end

end real

/- limits under pointwise operations -/

section limit_operations
open set
variable {A : Type}
variables {X Y : A → ℝ}
variables {x y : ℝ}
variable {F : filter A}

proposition mul_left_approaches (c : ℝ) (HX : (X ⟶ x) F) :
  ((λ n, c * X n) ⟶ c * x) F :=
smul_approaches HX c

proposition mul_right_approaches (c : ℝ) (HX : (X ⟶ x) F) :
  ((λ n, X n * c) ⟶ x * c) F :=
have (λ n, X n * c) = (λ n, c * X n), from funext (λ n, !mul.comm),
by rewrite [this, mul.comm]; apply mul_left_approaches _ HX

theorem approaches_squeeze (HX : (X ⟶ x) F) (HY : (Y ⟶ x) F)
        {Z : A → ℝ} (HZX : filter.eventually (λ n, X n ≤ Z n) F) (HZY : filter.eventually (λ n, Z n ≤ Y n) F) :
        (Z ⟶ x) F :=
  begin
    apply real.approaches_intro,
    intro ε Hε,
    apply filter.eventually_mp,
    rotate 1,
    apply filter.eventually_and,
    apply real.approaches_dest HX Hε,
    apply real.approaches_dest HY Hε,
    apply filter.eventually_mono,
    apply filter.eventually_and HZX HZY,
    intros x' Hlo Hdst,
    change abs (Z x' - x) < ε,
    cases em (x ≤ Z x') with HxleZ HxnleZ, -- annoying linear arith
    {have Y x' - x = (Z x' - x) + (Y x' - Z x'), by rewrite -sub_eq_sub_add_sub,
    have H : abs (Y x' - x) < ε, from and.right Hdst,
    rewrite this at H,
    have H'' : Y x' - Z x' ≥ 0, from sub_nonneg_of_le (and.right Hlo),
    have H' : Z x' - x ≥ 0, from sub_nonneg_of_le HxleZ,
    krewrite [abs_of_nonneg H', abs_of_nonneg (add_nonneg H' H'') at H],
    apply lt_of_add_lt_of_nonneg_left H H''},
    {have X x' - x = (Z x' - x) + (X x' - Z x'), by rewrite -sub_eq_sub_add_sub,
    have H : abs (X x' - x) < ε, from and.left Hdst,
    rewrite this at H,
    have H' : x - Z x' > 0, from sub_pos_of_lt (lt_of_not_ge HxnleZ),
    have H'2 : Z x' - x < 0,
      by rewrite [-neg_neg (Z x' - x)]; apply neg_neg_of_pos; rewrite [neg_sub]; apply H',
    have H'' : X x' - Z x' ≤ 0, from sub_nonpos_of_le (and.left Hlo),
    krewrite [abs_of_neg H'2, abs_of_neg (add_neg_of_neg_of_nonpos H'2 H'') at H, neg_add at H],
    apply lt_of_add_lt_of_nonneg_left H,
    apply neg_nonneg_of_nonpos H''}
  end

proposition approaches_of_abs_sub_approaches {F} (Habs : ((λ n, abs (X n - x)) ⟶ 0) F) :
            (X ⟶ x) F :=
  begin
    apply real.approaches_intro,
    intro ε Hε,
    apply set.filter.eventually_mono,
    apply real.approaches_dest Habs Hε,
    intro n Hn,
    have Hn' : abs (abs (X n - x) - 0) < ε, from Hn,
    rewrite [sub_zero at Hn', abs_abs at Hn'],
    exact Hn'
  end

proposition abs_sub_approaches_of_approaches {F} (HX : (X ⟶ x) F) :
            ((λ n, abs (X n - x)) ⟶ 0) F :=
  begin
    apply real.approaches_intro,
    intros ε Hε,
    apply set.filter.eventually_mono,
    apply real.approaches_dest HX Hε,
    intro n Hn,
    have Hn' : abs (abs (X n - x) - 0) < ε, by rewrite [sub_zero, abs_abs]; apply Hn,
    exact Hn'
  end

proposition bounded_of_approaches_real {F} (HX : (X ⟶ x) F) :
            ∃ K : ℝ, filter.eventually (λ n, abs (X n) ≤ K) F :=
  begin
    cases bounded_of_converges HX with K HK,
    existsi K + abs x,
    apply filter.eventually_mono HK,
    intro x' Hx',
    note Hle := abs_sub_abs_le_abs_sub (X x') x,
    apply le.trans,
    apply le_add_of_sub_right_le,
    apply Hle,
    apply add_le_add_right,
    apply Hx'
  end

proposition mul_approaches {F} (HX : (X ⟶ x) F) (HY : (Y ⟶ y) F) :
            ((λ n, X n * Y n) ⟶ x * y) F :=
    obtain K HK, from bounded_of_approaches_real HX,
    have Habsle : filter.eventually
         (λ n, abs (X n * Y n - x * y) ≤ K * abs (Y n - y) + abs y * abs (X n - x)) F, begin
      have Heq : ∀ n, X n * Y n - x * y = (X n * Y n - X n * y) + (X n * y - x * y),
        by intro n; rewrite [-sub_add_cancel (X n * Y n) (X n * y) at {1}, sub_eq_add_neg, *add.assoc],
      apply filter.eventually_mono HK,
      intro x' Hx',
      apply le.trans,
      rewrite Heq,
      apply abs_add_le_abs_add_abs,
      apply add_le_add,
      rewrite [-mul_sub_left_distrib, abs_mul],
      apply mul_le_mul_of_nonneg_right,
      apply Hx',
      apply abs_nonneg,
      rewrite [-mul_sub_right_distrib, abs_mul, mul.comm],
      apply le.refl
    end,
    have Hdifflim : ((λ n, abs (X n * Y n - x * y)) ⟶ 0) F, begin
      apply approaches_squeeze,
      rotate 2,
      intro,
      apply filter.eventually_mono HK,
      intro x' Hx',
      apply abs_nonneg,
      apply Habsle,
      apply approaches_constant,
      rewrite -{0}zero_add,
      apply add_approaches,
      krewrite -(mul_zero K),
      apply mul_left_approaches,
      apply abs_sub_approaches_of_approaches,
      exact HY,
      krewrite -(mul_zero (abs y)),
      apply mul_left_approaches,
      apply abs_sub_approaches_of_approaches,
      exact HX
    end,
    approaches_of_abs_sub_approaches Hdifflim

proposition mul_approaches_zero_of_approaches_zero_of_approaches (HX : (X ⟶ 0) F) (HY : (Y ⟶ y) F) :
            ((λ z, X z * Y z) ⟶ 0) F :=
  begin
    krewrite [-zero_mul y],
    apply mul_approaches,
    exact HX, exact HY
  end

proposition mul_approaches_zero_of_approaches_of_approaches_zero (HX : (X ⟶ y) F) (HY : (Y ⟶ 0) F) :
            ((λ z, X z * Y z) ⟶ 0) F :=
  begin
    have H : (λ z, X z * Y z) = (λ z, Y z * X z), from funext (λ a, !mul.comm),
    rewrite H,
    exact mul_approaches_zero_of_approaches_zero_of_approaches HY HX
  end

proposition abs_approaches_zero_of_approaches_zero (HX : (X ⟶ 0) F) : ((λ n, abs (X n)) ⟶ 0) F :=
norm_approaches_zero_of_approaches_zero HX

proposition approaches_zero_of_abs_approaches_zero (HX : ((λ n, abs (X n)) ⟶ 0) F) :
  (X ⟶ 0) F :=
approaches_zero_of_norm_approaches_zero HX

proposition abs_approaches_zero_iff :
  ((λ n, abs (X n)) ⟶ 0) F ↔ (X ⟶ 0) F :=
iff.intro approaches_zero_of_abs_approaches_zero abs_approaches_zero_of_approaches_zero
end limit_operations

/- monotone sequences -/

section monotone_sequences
open real set
variable {X : ℕ → ℝ}

proposition converges_to_seq_sup_of_nondecreasing (nondecX : nondecreasing X) {b : ℝ}
    (Hb : ∀ i, X i ≤ b) : X ⟶ sup (X ' univ) [at ∞] :=
real.approaches_at_infty_intro
(let sX := sup (X ' univ) in
have Xle : ∀ i, X i ≤ sX, from
  take i,
  have ∀ x, x ∈ X ' univ → x ≤ b, from
    (take x, assume H,
      obtain i [H' (Hi : X i = x)], from H,
      by rewrite -Hi; exact Hb i),
  show X i ≤ sX, from le_sup (mem_image_of_mem X !mem_univ) this,
have exX : ∃ x, x ∈ X ' univ,
  from exists.intro (X 0) (mem_image_of_mem X !mem_univ),
take ε, assume epos : ε > 0,
have sX - ε < sX, from !sub_lt_of_pos epos,
obtain x' [(H₁x' : x' ∈ X ' univ) (H₂x' : sX - ε < x')],
  from exists_mem_and_lt_of_lt_sup exX this,
obtain i [H' (Hi : X i = x')], from H₁x',
have Hi' : ∀ j, j ≥ i → sX - ε < X j, from
  take j, assume Hj, lt_of_lt_of_le (by rewrite Hi; apply H₂x') (nondecX Hj),
exists.intro i
  (take j, assume Hj : j ≥ i,
    have X j - sX ≤ 0, from sub_nonpos_of_le (Xle j),
    have eq₁ : abs (X j - sX) = sX - X j, by rewrite [abs_of_nonpos this, neg_sub],
    have sX - ε < X j, from lt_of_lt_of_le (by rewrite Hi; apply H₂x') (nondecX Hj),
    have sX < X j + ε, from lt_add_of_sub_lt_right this,
    have sX - X j < ε, from sub_lt_left_of_lt_add this,
    show (abs (X j - sX)) < ε, by rewrite eq₁; exact this))

proposition converges_to_seq_inf_of_nonincreasing (nonincX : nonincreasing X) {b : ℝ}
    (Hb : ∀ i, b ≤ X i) : X ⟶ inf (X ' univ) [at ∞] :=
have H₁ : ∃ x, x ∈ X ' univ, from exists.intro (X 0) (mem_image_of_mem X !mem_univ),
have H₂ : ∀ x, x ∈ X ' univ → b ≤ x, from
  (take x, assume H,
    obtain i [Hi₁ (Hi₂ : X i = x)], from H,
    show b ≤ x, by rewrite -Hi₂; apply Hb i),
have H₃ : {x : ℝ | -x ∈ X ' univ} = {x : ℝ | x ∈ (λ n, -X n) ' univ}, from calc
  {x : ℝ | -x ∈ X ' univ} = (λ y, -y) ' (X ' univ) : by rewrite image_neg_eq
                       ... = {x : ℝ | x ∈ (λ n, -X n) ' univ} : image_comp,
have H₄ : ∀ i, - X i ≤ - b, from take i, neg_le_neg (Hb i),
begin
  apply approaches_neg,
  -- need krewrite here
  krewrite [-sup_neg H₁ H₂, H₃, -nondecreasing_neg_iff at nonincX],
  apply converges_to_seq_sup_of_nondecreasing nonincX H₄
end

end monotone_sequences

/- x^n converges to 0 if abs x < 1 -/

section xn
open nat set

theorem pow_approaches_zero_at_infty {x : ℝ} (H : abs x < 1) :
  (λ n, x^n) ⟶ 0 [at ∞] :=
suffices H' : (λ n, (abs x)^n) ⟶ 0 [at ∞], from
  have (λ n, (abs x)^n) = (λ n, abs (x^n)), from funext (take n, eq.symm !abs_pow),
    by rewrite this at H'; exact approaches_zero_of_abs_approaches_zero H',
let  aX := (λ n, (abs x)^n),
    iaX := real.inf (aX ' univ),
    asX := (λ n, (abs x)^(succ n)) in
have noninc_aX : nonincreasing aX, from
  nonincreasing_of_forall_ge_succ
    (take i,
      have (abs x) * (abs x)^i ≤ 1 * (abs x)^i,
        from mul_le_mul_of_nonneg_right (le_of_lt H) (!pow_nonneg_of_nonneg !abs_nonneg),
      have (abs x) * (abs x)^i ≤ (abs x)^i, by krewrite one_mul at this; exact this,
      show (abs x) ^ (succ i) ≤ (abs x)^i, by rewrite pow_succ; apply this),
have bdd_aX : ∀ i, 0 ≤ aX i, from take i, !pow_nonneg_of_nonneg !abs_nonneg,
have aXconv : aX ⟶ iaX [at ∞], proof converges_to_seq_inf_of_nonincreasing noninc_aX bdd_aX qed,
have asXconv : asX ⟶ iaX [at ∞], from tendsto_succ_at_infty aXconv,
have asXconv' : asX ⟶ (abs x) * iaX [at ∞], from mul_left_approaches (abs x) aXconv,
have iaX = (abs x) * iaX, from sorry, -- converges_to_seq_unique asXconv asXconv',
have iaX = 0, from eq_zero_of_mul_eq_self_left (ne_of_lt H) (eq.symm this),
show aX ⟶ 0 [at ∞], begin rewrite -this, exact aXconv end --from this ▸ aXconv

end xn

/- continuity on the reals -/

/-namespace real
open topology set
open normed_vector_space

section
variable {f : ℝ → ℝ}

theorem continuous_dest (H : continuous f) :
  ∀ x : ℝ, ∀ ⦃ε : ℝ⦄, ε > 0 → ∃ δ : ℝ, δ > 0 ∧ ∀ x' : ℝ,
    abs (x' - x) < δ → abs (f x' - f x) < ε :=
normed_vector_space.continuous_dest H

theorem continuous_intro
  (H : ∀ x : ℝ, ∀ ⦃ε : ℝ⦄, ε > 0 → ∃ δ : ℝ, δ > 0 ∧ ∀ x' : ℝ,
    abs (x' - x) < δ → abs (f x' - f x) < ε) :
  continuous f :=
normed_vector_space.continuous_intro H

theorem continuous_at_dest {x : ℝ} (H : continuous_at f x) :
         ∀ ε : ℝ, ε > 0 → (∃ δ : ℝ, δ > 0 ∧ ∀ x' : ℝ, abs (x' - x) < δ → abs (f x' - f x) < ε) :=
normed_vector_space.continuous_at_dest H

theorem continuous_at_intro {x : ℝ}
  (H : ∀ ⦃ε : ℝ⦄, ε > 0 → ∃ δ : ℝ, δ > 0 ∧ ∀ x' : ℝ,
    abs (x' - x) < δ → abs (f x' - f x) < ε) :
  continuous_at f x :=
normed_vector_space.continuous_at_intro H

theorem continuous_at_within_intro {x : ℝ} {s : set ℝ}
        (H : ∀ ⦃ε⦄, ε > 0 → ∃ δ, δ > 0 ∧ ∀ ⦃x'⦄, x' ∈ s → abs (x' - x) < δ → abs ((f x') - (f x)) < ε) :
  continuous_at_on f x s :=
normed_vector_space.continuous_at_within_intro H

theorem continuous_at_on_dest {x : ℝ} {s : set ℝ} (Hfx : continuous_at_on f x s) :
         ∀ ⦃ε⦄, ε > 0 → ∃ δ, δ > 0 ∧ ∀ ⦃x'⦄, x' ∈ s → abs (x' - x) < δ → abs ((f x') - (f x)) < ε :=
normed_vector_space.continuous_at_on_dest Hfx

theorem continuous_on_intro {s : set ℝ}
        (H : ∀ x ⦃ε⦄, ε > 0 → ∃ δ, δ > 0 ∧ ∀ ⦃x'⦄, x' ∈ s → abs (x' - x) < δ → abs ((f x') - (f x)) < ε) :
        continuous_on f s :=
normed_vector_space.continuous_on_intro H

theorem continuous_on_dest {s : set ℝ} (H : continuous_on f s) {x : ℝ} (Hxs : x ∈ s) :
        ∀ ⦃ε⦄, ε > 0 → ∃ δ, δ > 0 ∧ ∀ ⦃x'⦄, x' ∈ s → abs (x' - x) < δ → abs ((f x') - (f x)) < ε :=
normed_vector_space.continuous_on_dest H Hxs

end

section
variable {f : ℕ → ℝ}
proposition approaches_at_infty_intro {y : ℝ}
    (H : ∀ ε, ε > 0 → ∃ N, ∀ n, n ≥ N → abs ((f n) - y) < ε) :
  f ⟶ y [at ∞] :=
normed_vector_space.approaches_at_infty_intro H

proposition approaches_at_infty_dest {y : ℝ}
    (H : f ⟶ y [at ∞]) ⦃ε : ℝ⦄ (εpos : ε > 0) :
  ∃ N, ∀ ⦃n⦄, n ≥ N → abs ((f n) - y) < ε :=
approaches_at_infty_dest H εpos

proposition approaches_at_infty_iff (y : ℝ) :
  f ⟶ y [at ∞] ↔ (∀ ε, ε > 0 → ∃ N, ∀ ⦃n⦄, n ≥ N → abs((f n) - y) < ε) :=
iff.intro approaches_at_infty_dest approaches_at_infty_intro

end

section
variable {f : ℝ → ℝ}
proposition approaches_at_dest  {y x : ℝ}
    (H : f ⟶ y [at x]) ⦃ε : ℝ⦄ (εpos : ε > 0) :
  ∃ δ, δ > 0 ∧ ∀ ⦃x'⦄, abs (x' - x) < δ → x' ≠ x → abs ((f x') - y) < ε :=
approaches_at_dest H εpos

proposition approaches_at_intro {y x : ℝ}
    (H : ∀ ε, ε > 0 → ∃ δ, δ > 0 ∧ ∀ ⦃x'⦄, abs (x' - x) < δ → x' ≠ x → abs ((f x') - y) < ε) :
  f ⟶ y [at x] :=
approaches_at_intro H

proposition approaches_at_iff (y x : ℝ) : f ⟶ y [at x] ↔
    (∀ ⦃ε⦄, ε > 0 → ∃ δ, δ > 0 ∧ ∀ ⦃x'⦄, abs (x' - x) < δ → x' ≠ x → abs ((f x') - y) < ε) :=
iff.intro approaches_at_dest approaches_at_intro

/-proposition approaches_seq_real_intro {X : ℕ → ℝ} {y : ℝ}
    (H : ∀ ⦃ε : ℝ⦄, ε > 0 → ∃ N : ℕ, ∀ {n}, n ≥ N → abs (X n - y) < ε) :
  (X ⟶ y [at ∞]) := metric_space.approaches_at_infty_intro H

proposition approaches_seq_real_elim {X : ℕ → ℝ} {y : ℝ} (H : X ⟶ y [at ∞]) :
    ∀ ⦃ε : ℝ⦄, ε > 0 → ∃ N : ℕ, ∀ {n}, n ≥ N → abs (X n - y) < ε := metric_space.approaches_at_infty_dest H

proposition approaches_seq_real_intro' {X : ℕ → ℝ} {y : ℝ}
    (H : ∀ ⦃ε : ℝ⦄, ε > 0 → ∃ N : ℕ, ∀ {n}, n ≥ N → abs (X n - y) ≤ ε) :
  (X ⟶ y [at ∞]) :=
approaches_at_infty_intro' H-/

end

end real-/

section continuous
open topology
variable {f : ℝ → ℝ}
variable (Hf : continuous f)
include Hf

theorem pos_on_nbhd_of_cts_of_pos {b : ℝ} (Hb : f b > 0) :
                ∃ δ : ℝ, δ > 0 ∧ ∀ y, abs (y - b) < δ → f y > 0 :=
  begin
    let Hcont := real.continuous_dest Hf b Hb,
    cases Hcont with δ Hδ,
    existsi δ,
    split,
    exact and.left Hδ,
    intro y Hy,
    let Hy' := and.right Hδ y Hy,
    note Hlt := sub_lt_of_abs_sub_lt_left Hy',
    rewrite sub_self at Hlt,
    assumption
  end

theorem neg_on_nbhd_of_cts_of_neg {b : ℝ} (Hb : f b < 0) :
                ∃ δ : ℝ, δ > 0 ∧ ∀ y, abs (y - b) < δ → f y < 0 :=
  begin
    let Hcont := real.continuous_dest Hf b (neg_pos_of_neg Hb),
    cases Hcont with δ Hδ,
    existsi δ,
    split,
    exact and.left Hδ,
    intro y Hy,
    let Hy' := and.right Hδ y Hy,
    let Hlt := sub_lt_of_abs_sub_lt_right Hy',
    note Hlt' := lt_add_of_sub_lt_left Hlt,
    rewrite [add.comm at Hlt', -sub_eq_add_neg at Hlt', sub_self at Hlt'],
    assumption
  end

theorem continuous_mul_of_continuous {g : ℝ → ℝ} (Hcong : continuous g) :
        continuous (λ x, f x * g x) :=
  begin
    apply continuous_of_forall_continuous_at,
    intro x,
    apply continuous_at_of_tendsto_at,
    apply mul_approaches,
    all_goals apply tendsto_at_of_continuous_at,
    all_goals apply forall_continuous_at_of_continuous,
    apply Hf,
    apply Hcong
  end

end continuous


/-
Copyright (c) 2022 Chris Birkbeck. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Birkbeck
-/
import data.zmod.basic
import group_theory.group_action.conj_act
import group_theory.subgroup.pointwise
import linear_algebra.matrix.special_linear_group
/-!
# Congruence subgroups

This defines congruence subgroups of `SL(2, ℤ)` such as `Γ(N)`, `Γ₀(N)` and `Γ₁(N)` for `N` a
natural number.

It also contains basic results about congruence subgroups.

-/

local notation `SL(` n `, ` R `)`:= matrix.special_linear_group (fin n) R

local attribute [-instance] matrix.special_linear_group.has_coe_to_fun

local prefix `↑ₘ`:1024 := @coe _ (matrix (fin 2) (fin 2) _) _

open matrix.special_linear_group matrix

variable (N : ℕ)

local notation `SLMOD(`N`)`  := @matrix.special_linear_group.map (fin 2) _ _ _ _ _ _
  (int.cast_ring_hom (zmod N))

@[simp]
lemma SL_reduction_mod_hom_val (N : ℕ) (γ : SL(2, ℤ)) : ∀ (i j : fin 2),
  ((SLMOD(N) γ) : (matrix (fin 2) (fin 2) (zmod N))) i j =
  (((↑ₘγ i j) : ℤ) : zmod N) := λ i j, rfl

/--The full level `N` congruence subgroup of `SL(2, ℤ)` of matrices that reduce to the identity
modulo `N`.-/
def Gamma (N : ℕ) : subgroup SL(2, ℤ) := (SLMOD(N)).ker

lemma Gamma_mem' (N : ℕ) (γ : SL(2, ℤ)) : γ ∈ Gamma N ↔ SLMOD(N) γ = 1 := iff.rfl

@[simp]
lemma Gamma_mem (N : ℕ) (γ : SL(2, ℤ)) : γ ∈ Gamma N ↔ (((↑ₘγ 0 0) : ℤ) : zmod N) = 1 ∧
  (((↑ₘγ 0 1) : ℤ) : zmod N) = 0 ∧ (((↑ₘγ 1 0) : ℤ) : zmod N) = 0 ∧
  (((↑ₘγ 1 1) : ℤ) : zmod N) = 1 :=
begin
  rw Gamma_mem',
  split,
  { intro h,
    simp [←(SL_reduction_mod_hom_val N γ), h] },
  { intro h,
    ext,
    rw SL_reduction_mod_hom_val N γ,
    fin_cases i; fin_cases j,
    all_goals {simp_rw h, refl} }
end

lemma Gamma_normal (N : ℕ) : subgroup.normal (Gamma N) := (SLMOD(N)).normal_ker

lemma Gamma_one_top : Gamma 1 = ⊤ :=
begin
  ext,
  simp,
end

lemma Gamma_zero_bot : Gamma 0 = ⊥ :=
begin
  ext,
  simp only [Gamma_mem, coe_coe, coe_matrix_coe, int.coe_cast_ring_hom, map_apply, int.cast_id,
    subgroup.mem_bot],
  split,
  { intro h,
    ext,
    fin_cases i; fin_cases j,
    any_goals {simp [h]} },
  { intro h,
    simp [h] }
end

/--The congruence subgroup of `SL(2, ℤ)` of matrices whose lower left-hand entry reduces to zero
modulo `N`. -/
def Gamma0 (N : ℕ) : subgroup SL(2, ℤ) :=
{ carrier := { g : SL(2, ℤ) | ((↑ₘg 1 0 : ℤ) : zmod N) = 0 },
  one_mem' := by { simp },
  mul_mem':= by {intros a b ha hb,
    simp only [ set.mem_set_of_eq],
    have h := ((matrix.two_mul_expl a.1 b.1).2.2.1),
    simp only [coe_coe, coe_matrix_coe, coe_mul, int.coe_cast_ring_hom, map_apply,
      set.mem_set_of_eq, subtype.val_eq_coe, mul_eq_mul] at *,
    rw h,
    simp [ha, hb] },
  inv_mem':= by {intros a ha,
    simp only [ set.mem_set_of_eq, subtype.val_eq_coe],
    rw (SL2_inv_expl a),
    simp only [subtype.val_eq_coe, cons_val_zero, cons_val_one, head_cons, coe_coe, coe_matrix_coe,
      coe_mk, int.coe_cast_ring_hom, map_apply, int.cast_neg, neg_eq_zero, set.mem_set_of_eq] at *,
    exact ha } }

@[simp]
lemma Gamma0_mem (N : ℕ) (A: SL(2, ℤ)) : A ∈ Gamma0 N ↔ (((↑ₘA) 1 0 : ℤ) : zmod N) = 0 := iff.rfl

lemma Gamma0_det (N : ℕ) (A : Gamma0 N) : (A.1.1.det : zmod N) = 1 :=
by {simp [A.1.property]}

/--The group homomorphism from `Gamma0` to `zmod N` given by mapping a matrix to its lower
right-hand entry. -/
def Gamma_0_map (N : ℕ): Gamma0 N →* zmod N :=
{ to_fun := λ g, ((↑ₘg 1 1 : ℤ) : zmod N),
  map_one' := by { simp, },
  map_mul' := by {intros A B,
  have := (two_mul_expl A.1.1 B.1.1).2.2.2,
  simp only [coe_coe, subgroup.coe_mul, coe_matrix_coe, coe_mul, int.coe_cast_ring_hom, map_apply,
    subtype.val_eq_coe, mul_eq_mul] at *,
  rw this,
  have ha := A.property,
  simp only [int.cast_add, int.cast_mul, add_left_eq_self, subtype.val_eq_coe, Gamma0_mem, coe_coe,
    coe_matrix_coe, int.coe_cast_ring_hom, map_apply] at *,
  rw ha,
  simp,} }

/--The congruence subgroup `Gamma1` (as a subgroup of `Gamma0`) of matrices whose bottom
row is congruent to `(0,1)` modulo `N`.-/
def Gamma1' (N : ℕ) : subgroup (Gamma0 N) := (Gamma_0_map N).ker

@[simp]
lemma Gamma1_mem' (N : ℕ) (γ : Gamma0 N) : γ ∈ Gamma1' N ↔ (Gamma_0_map N) γ = 1 := iff.rfl

lemma Gamma1_to_Gamma0_mem (N : ℕ) (A : Gamma0 N) : A ∈ Gamma1' N ↔
  ((↑ₘA 0 0 : ℤ) : zmod N) = 1 ∧ ((↑ₘA 1 1 : ℤ) : zmod N) = 1 ∧ ((↑ₘA 1 0 : ℤ) : zmod N) = 0 :=
begin
  split,
  { intro ha,
    have hA := A.property,
    rw Gamma0_mem at hA,
    have adet := Gamma0_det N A,
    rw matrix.det_fin_two at adet,
    simp only [Gamma_0_map, coe_coe, coe_matrix_coe, int.coe_cast_ring_hom, map_apply, Gamma1_mem',
      monoid_hom.coe_mk, subtype.val_eq_coe, int.cast_sub, int.cast_mul] at *,
    rw [hA, ha] at adet,
    simp only [mul_one, mul_zero, sub_zero] at adet,
    simp only [adet, hA, ha, eq_self_iff_true, and_self]},
  { intro ha,
    simp only [Gamma1_mem', Gamma_0_map, monoid_hom.coe_mk, coe_coe, coe_matrix_coe,
      int.coe_cast_ring_hom, map_apply],
    exact ha.2.1,}
end

/--The congruence subgroup `Gamma1` of `SL(2, ℤ)` consisting of matrices whose bottom
row is congruent to `(0,1)` modulo `N`. -/
def Gamma1 (N : ℕ) : subgroup SL(2, ℤ) := subgroup.map
(((Gamma0 N).subtype).comp (Gamma1' N).subtype) ⊤

@[simp]
lemma Gamma1_mem (N : ℕ) (A : SL(2, ℤ)) : A ∈ Gamma1 N ↔
  ((↑ₘA 0 0 : ℤ) : zmod N) = 1 ∧ ((↑ₘA 1 1 : ℤ) : zmod N) = 1 ∧ ((↑ₘA 1 0 : ℤ) : zmod N) = 0 :=
begin
  split,
  { intro ha,
    simp_rw [Gamma1, subgroup.mem_map] at ha,
    simp at ha,
    obtain ⟨⟨x, hx⟩, hxx⟩ := ha,
    rw Gamma1_to_Gamma0_mem at hx,
    rw ←hxx,
    convert hx },
  { intro ha,
    simp_rw [Gamma1, subgroup.mem_map],
    have hA : A ∈ (Gamma0 N), by {simp [ha.right.right, Gamma0_mem, subtype.val_eq_coe],},
    have HA : (⟨A , hA⟩ : Gamma0 N) ∈ Gamma1' N,
      by {simp only [Gamma1_to_Gamma0_mem, subgroup.coe_mk, coe_coe, coe_matrix_coe,
        int.coe_cast_ring_hom, map_apply],
      exact ha,},
    refine ⟨(⟨(⟨A , hA⟩ : Gamma0 N), HA ⟩ : (( Gamma1' N ) : subgroup (Gamma0 N))), _⟩,
    simp }
end

lemma Gamma1_in_Gamma0 (N : ℕ) : Gamma1 N ≤ Gamma0 N :=
begin
  intros x HA,
  simp only [Gamma0_mem, Gamma1_mem, coe_coe, coe_matrix_coe, int.coe_cast_ring_hom,
    map_apply] at *,
  exact HA.2.2,
end

section congruence_subgroup

/--A congruence subgroup is a subgroup of `SL(2, ℤ)` which contains some `Gamma N` for some
`(N : ℕ+)`. -/
def is_congruence_subgroup (Γ : subgroup SL(2, ℤ)) : Prop := ∃ (N : ℕ+), Gamma N ≤ Γ

lemma is_congruence_subgroup_trans (H K : subgroup SL(2, ℤ)) (h: H ≤ K)
  (h2 : is_congruence_subgroup H) : is_congruence_subgroup K :=
begin
  obtain ⟨N , hN⟩ := h2,
  refine ⟨N, le_trans hN h⟩,
end

lemma Gamma_is_cong_sub (N : ℕ+) : is_congruence_subgroup (Gamma N) :=
⟨N, by {simp only [le_refl]}⟩

lemma Gamma1_is_congruence (N : ℕ+) : is_congruence_subgroup (Gamma1 N) :=
begin
  refine ⟨N, _⟩,
  intros A hA,
  simp only [Gamma1_mem, Gamma_mem] at *,
  simp only [hA, eq_self_iff_true, and_self],
end

lemma Gamma0_is_congruence (N : ℕ+) : is_congruence_subgroup (Gamma0 N) :=
is_congruence_subgroup_trans _ _ (Gamma1_in_Gamma0 N) (Gamma1_is_congruence N)

end congruence_subgroup

section conjugation

open_locale pointwise

lemma Gamma_cong_eq_self (N : ℕ) (g : conj_act SL(2, ℤ)) : g • (Gamma N) = Gamma N :=
begin
  apply subgroup.normal.conj_act (Gamma_normal N),
end

lemma conj_cong_is_cong (g : conj_act SL(2, ℤ)) (Γ : subgroup SL(2, ℤ))
  (h : is_congruence_subgroup Γ) : is_congruence_subgroup (g • Γ) :=
begin
  obtain ⟨N, HN⟩ := h,
  refine ⟨N, _⟩,
  rw [←Gamma_cong_eq_self N g, subgroup.pointwise_smul_le_pointwise_smul_iff],
  exact HN,
end

end conjugation