/-
Copyright (c) 2021 Thomas Browning. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Thomas Browning

! This file was ported from Lean 3 source module group_theory.index
! leanprover-community/mathlib commit dc6c365e751e34d100e80fe6e314c3c3e0fd2988
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Finite.Card
import Mathlib.GroupTheory.Finiteness
import Mathlib.GroupTheory.GroupAction.Quotient

/-!
# Index of a Subgroup

In this file we define the index of a subgroup, and prove several divisibility properties.
Several theorems proved in this file are known as Lagrange's theorem.

## Main definitions

- `H.index` : the index of `H : Subgroup G` as a natural number,
  and returns 0 if the index is infinite.
- `H.relindex K` : the relative index of `H : Subgroup G` in `K : Subgroup G` as a natural number,
  and returns 0 if the relative index is infinite.

# Main results

- `card_mul_index` : `Nat.card H * H.index = Nat.card G`
- `index_mul_card` : `H.index * Fintype.card H = Fintype.card G`
- `index_dvd_card` : `H.index ∣ Fintype.card G`
- `index_eq_mul_of_le` : If `H ≤ K`, then `H.index = K.index * (H.subgroupOf K).index`
- `index_dvd_of_le` : If `H ≤ K`, then `K.index ∣ H.index`
- `relindex_mul_relindex` : `relindex` is multiplicative in towers

-/

namespace Subgroup

open BigOperators Cardinal

variable {G : Type _} [Group G] (H K L : Subgroup G)

/-- The index of a subgroup as a natural number, and returns 0 if the index is infinite. -/
@[to_additive "The index of a subgroup as a natural number,
and returns 0 if the index is infinite."]
noncomputable def index : ℕ :=
  Nat.card (G ⧸ H)
#align subgroup.index Subgroup.index
#align add_subgroup.index AddSubgroup.index

/-- The relative index of a subgroup as a natural number,
  and returns 0 if the relative index is infinite. -/
@[to_additive "The relative index of a subgroup as a natural number,
and returns 0 if the relative index is infinite."]
noncomputable def relindex : ℕ :=
  (H.subgroupOf K).index
#align subgroup.relindex Subgroup.relindex
#align add_subgroup.relindex AddSubgroup.relindex

@[to_additive]
theorem index_comap_of_surjective {G' : Type _} [Group G'] {f : G' →* G}
    (hf : Function.Surjective f) : (H.comap f).index = H.index := by
  letI := QuotientGroup.leftRel H
  letI := QuotientGroup.leftRel (H.comap f)
  have key : ∀ x y : G', Setoid.r x y ↔ Setoid.r (f x) (f y) :=
    by
    simp only [QuotientGroup.leftRel_apply]
    exact fun x y => iff_of_eq (congr_arg (· ∈ H) (by rw [f.map_mul, f.map_inv]))
  refine' Cardinal.toNat_congr (Equiv.ofBijective (Quotient.map' f fun x y => (key x y).mp) ⟨_, _⟩)
  · simp_rw [← Quotient.eq''] at key
    refine' Quotient.ind' fun x => _
    refine' Quotient.ind' fun y => _
    exact (key x y).mpr
  · refine' Quotient.ind' fun x => _
    obtain ⟨y, hy⟩ := hf x
    exact ⟨y, (Quotient.map'_mk'' f _ y).trans (congr_arg Quotient.mk'' hy)⟩
#align subgroup.index_comap_of_surjective Subgroup.index_comap_of_surjective
#align add_subgroup.index_comap_of_surjective AddSubgroup.index_comap_of_surjective

@[to_additive]
theorem index_comap {G' : Type _} [Group G'] (f : G' →* G) :
    (H.comap f).index = H.relindex f.range :=
  Eq.trans (congr_arg index (by rfl))
    ((H.subgroupOf f.range).index_comap_of_surjective f.rangeRestrict_surjective)
#align subgroup.index_comap Subgroup.index_comap
#align add_subgroup.index_comap AddSubgroup.index_comap

@[to_additive]
theorem relindex_comap {G' : Type _} [Group G'] (f : G' →* G) (K : Subgroup G') :
    relindex (comap f H) K = relindex H (map f K) := by
  rw [relindex, subgroupOf, comap_comap, index_comap, ← f.map_range, K.subtype_range]
#align subgroup.relindex_comap Subgroup.relindex_comap
#align add_subgroup.relindex_comap AddSubgroup.relindex_comap

variable {H K L}

@[to_additive relindex_mul_index]
theorem relindex_mul_index (h : H ≤ K) : H.relindex K * K.index = H.index :=
  ((mul_comm _ _).trans (Cardinal.toNat_mul _ _).symm).trans
    (congr_arg Cardinal.toNat (Equiv.cardinal_eq (quotientEquivProdOfLe h))).symm
#align subgroup.relindex_mul_index Subgroup.relindex_mul_index
#align add_subgroup.relindex_mul_index AddSubgroup.relindex_mul_index

@[to_additive]
theorem index_dvd_of_le (h : H ≤ K) : K.index ∣ H.index :=
  dvd_of_mul_left_eq (H.relindex K) (relindex_mul_index h)
#align subgroup.index_dvd_of_le Subgroup.index_dvd_of_le
#align add_subgroup.index_dvd_of_le AddSubgroup.index_dvd_of_le

@[to_additive]
theorem relindex_dvd_index_of_le (h : H ≤ K) : H.relindex K ∣ H.index :=
  dvd_of_mul_right_eq K.index (relindex_mul_index h)
#align subgroup.relindex_dvd_index_of_le Subgroup.relindex_dvd_index_of_le
#align add_subgroup.relindex_dvd_index_of_le AddSubgroup.relindex_dvd_index_of_le

@[to_additive]
theorem relindex_subgroupOf (hKL : K ≤ L) :
    (H.subgroupOf L).relindex (K.subgroupOf L) = H.relindex K :=
  ((index_comap (H.subgroupOf L) (inclusion hKL)).trans (congr_arg _ (inclusion_range hKL))).symm
#align subgroup.relindex_subgroup_of Subgroup.relindex_subgroupOf
#align add_subgroup.relindex_add_subgroup_of AddSubgroup.relindex_addSubgroupOf

variable (H K L)

@[to_additive relindex_mul_relindex]
theorem relindex_mul_relindex (hHK : H ≤ K) (hKL : K ≤ L) :
    H.relindex K * K.relindex L = H.relindex L := by
  rw [← relindex_subgroupOf hKL]
  exact relindex_mul_index fun x hx => hHK hx
#align subgroup.relindex_mul_relindex Subgroup.relindex_mul_relindex
#align add_subgroup.relindex_mul_relindex AddSubgroup.relindex_mul_relindex

@[to_additive]
theorem inf_relindex_right : (H ⊓ K).relindex K = H.relindex K := by
  rw [relindex, relindex, inf_subgroupOf_right]
#align subgroup.inf_relindex_right Subgroup.inf_relindex_right
#align add_subgroup.inf_relindex_right AddSubgroup.inf_relindex_right

@[to_additive]
theorem inf_relindex_left : (H ⊓ K).relindex H = K.relindex H := by
  rw [inf_comm, inf_relindex_right]
#align subgroup.inf_relindex_left Subgroup.inf_relindex_left
#align add_subgroup.inf_relindex_left AddSubgroup.inf_relindex_left

@[to_additive relindex_inf_mul_relindex]
theorem relindex_inf_mul_relindex : H.relindex (K ⊓ L) * K.relindex L = (H ⊓ K).relindex L := by
  rw [← inf_relindex_right H (K ⊓ L), ← inf_relindex_right K L, ← inf_relindex_right (H ⊓ K) L,
    inf_assoc, relindex_mul_relindex (H ⊓ (K ⊓ L)) (K ⊓ L) L inf_le_right inf_le_right]
#align subgroup.relindex_inf_mul_relindex Subgroup.relindex_inf_mul_relindex
#align add_subgroup.relindex_inf_mul_relindex AddSubgroup.relindex_inf_mul_relindex

@[to_additive (attr := simp)]
theorem relindex_sup_right [K.Normal] : K.relindex (H ⊔ K) = K.relindex H :=
  Nat.card_congr (QuotientGroup.quotientInfEquivProdNormalQuotient H K).toEquiv.symm
#align subgroup.relindex_sup_right Subgroup.relindex_sup_right
#align add_subgroup.relindex_sup_right AddSubgroup.relindex_sup_right

@[to_additive (attr := simp)]
theorem relindex_sup_left [K.Normal] : K.relindex (K ⊔ H) = K.relindex H := by
  rw [sup_comm, relindex_sup_right]
#align subgroup.relindex_sup_left Subgroup.relindex_sup_left
#align add_subgroup.relindex_sup_left AddSubgroup.relindex_sup_left

@[to_additive]
theorem relindex_dvd_index_of_normal [H.Normal] : H.relindex K ∣ H.index :=
  relindex_sup_right K H ▸ relindex_dvd_index_of_le le_sup_right
#align subgroup.relindex_dvd_index_of_normal Subgroup.relindex_dvd_index_of_normal
#align add_subgroup.relindex_dvd_index_of_normal AddSubgroup.relindex_dvd_index_of_normal

variable {H K}

@[to_additive]
theorem relindex_dvd_of_le_left (hHK : H ≤ K) : K.relindex L ∣ H.relindex L :=
  inf_of_le_left hHK ▸ dvd_of_mul_left_eq _ (relindex_inf_mul_relindex _ _ _)
#align subgroup.relindex_dvd_of_le_left Subgroup.relindex_dvd_of_le_left
#align add_subgroup.relindex_dvd_of_le_left AddSubgroup.relindex_dvd_of_le_left

/-- A subgroup has index two if and only if there exists `a` such that for all `b`, exactly one
of `b * a` and `b` belong to `H`. -/
@[to_additive "An additive subgroup has index two if and only if there exists `a` such that
for all `b`, exactly one of `b + a` and `b` belong to `H`."]
theorem index_eq_two_iff : H.index = 2 ↔ ∃ a, ∀ b, Xor' (b * a ∈ H) (b ∈ H) := by
  simp only [index, Nat.card_eq_two_iff' ((1 : G) : G ⧸ H), ExistsUnique, inv_mem_iff,
    QuotientGroup.exists_mk, QuotientGroup.forall_mk, Ne.def, QuotientGroup.eq, mul_one,
    xor_iff_iff_not]
  refine'
    exists_congr fun a => ⟨fun ha b => ⟨fun hba hb => _, fun hb => _⟩, fun ha => ⟨_, fun b hb => _⟩⟩
  · exact ha.1 ((mul_mem_cancel_left hb).1 hba)
  · exact inv_inv b ▸ ha.2 _ (mt (inv_mem_iff (x := b)).1 hb)
  · rw [← inv_mem_iff (x := a), ← ha, inv_mul_self]
    exact one_mem _
  · rwa [ha, inv_mem_iff (x := b)]
#align subgroup.index_eq_two_iff Subgroup.index_eq_two_iff
#align add_subgroup.index_eq_two_iff AddSubgroup.index_eq_two_iff

@[to_additive]
theorem mul_mem_iff_of_index_two (h : H.index = 2) {a b : G} : a * b ∈ H ↔ (a ∈ H ↔ b ∈ H) := by
  by_cases ha : a ∈ H; · simp only [ha, true_iff_iff, mul_mem_cancel_left ha]
  by_cases hb : b ∈ H; · simp only [hb, iff_true_iff, mul_mem_cancel_right hb]
  simp only [ha, hb, iff_self_iff, iff_true_iff]
  rcases index_eq_two_iff.1 h with ⟨c, hc⟩
  refine' (hc _).or.resolve_left _
  rwa [mul_assoc, mul_mem_cancel_right ((hc _).or.resolve_right hb)]
#align subgroup.mul_mem_iff_of_index_two Subgroup.mul_mem_iff_of_index_two
#align add_subgroup.add_mem_iff_of_index_two AddSubgroup.add_mem_iff_of_index_two

@[to_additive]
theorem mul_self_mem_of_index_two (h : H.index = 2) (a : G) : a * a ∈ H := by
  rw [mul_mem_iff_of_index_two h]
#align subgroup.mul_self_mem_of_index_two Subgroup.mul_self_mem_of_index_two
#align add_subgroup.add_self_mem_of_index_two AddSubgroup.add_self_mem_of_index_two

@[to_additive two_smul_mem_of_index_two]
theorem sq_mem_of_index_two (h : H.index = 2) (a : G) : a ^ 2 ∈ H :=
  (pow_two a).symm ▸ mul_self_mem_of_index_two h a
#align subgroup.sq_mem_of_index_two Subgroup.sq_mem_of_index_two
#align add_subgroup.two_smul_mem_of_index_two AddSubgroup.two_smul_mem_of_index_two

variable (H K)

--porting note: had to replace `Cardinal.toNat_eq_one_iff_unique` with `Nat.card_eq_one_iff_unique`
@[to_additive (attr := simp)]
theorem index_top : (⊤ : Subgroup G).index = 1 :=
  Nat.card_eq_one_iff_unique.mpr ⟨QuotientGroup.subsingleton_quotient_top, ⟨1⟩⟩
#align subgroup.index_top Subgroup.index_top
#align add_subgroup.index_top AddSubgroup.index_top

@[to_additive (attr := simp)]
theorem index_bot : (⊥ : Subgroup G).index = Nat.card G :=
  Cardinal.toNat_congr QuotientGroup.quotientBot.toEquiv
#align subgroup.index_bot Subgroup.index_bot
#align add_subgroup.index_bot AddSubgroup.index_bot

@[to_additive]
theorem index_bot_eq_card [Fintype G] : (⊥ : Subgroup G).index = Fintype.card G :=
  index_bot.trans Nat.card_eq_fintype_card
#align subgroup.index_bot_eq_card Subgroup.index_bot_eq_card
#align add_subgroup.index_bot_eq_card AddSubgroup.index_bot_eq_card

@[to_additive (attr := simp)]
theorem relindex_top_left : (⊤ : Subgroup G).relindex H = 1 :=
  index_top
#align subgroup.relindex_top_left Subgroup.relindex_top_left
#align add_subgroup.relindex_top_left AddSubgroup.relindex_top_left

@[to_additive (attr := simp)]
theorem relindex_top_right : H.relindex ⊤ = H.index := by
  rw [← relindex_mul_index (show H ≤ ⊤ from le_top), index_top, mul_one]
#align subgroup.relindex_top_right Subgroup.relindex_top_right
#align add_subgroup.relindex_top_right AddSubgroup.relindex_top_right

@[to_additive (attr := simp)]
theorem relindex_bot_left : (⊥ : Subgroup G).relindex H = Nat.card H := by
  rw [relindex, bot_subgroupOf, index_bot]
#align subgroup.relindex_bot_left Subgroup.relindex_bot_left
#align add_subgroup.relindex_bot_left AddSubgroup.relindex_bot_left

@[to_additive]
theorem relindex_bot_left_eq_card [Fintype H] : (⊥ : Subgroup G).relindex H = Fintype.card H :=
  H.relindex_bot_left.trans Nat.card_eq_fintype_card
#align subgroup.relindex_bot_left_eq_card Subgroup.relindex_bot_left_eq_card
#align add_subgroup.relindex_bot_left_eq_card AddSubgroup.relindex_bot_left_eq_card

@[to_additive (attr := simp)]
theorem relindex_bot_right : H.relindex ⊥ = 1 := by rw [relindex, subgroupOf_bot_eq_top, index_top]
#align subgroup.relindex_bot_right Subgroup.relindex_bot_right
#align add_subgroup.relindex_bot_right AddSubgroup.relindex_bot_right

@[to_additive (attr := simp)]
theorem relindex_self : H.relindex H = 1 := by rw [relindex, subgroupOf_self, index_top]
#align subgroup.relindex_self Subgroup.relindex_self
#align add_subgroup.relindex_self AddSubgroup.relindex_self

@[to_additive]
theorem index_ker {H} [Group H] (f : G →* H) : f.ker.index = Nat.card (Set.range f) := by
  rw [← MonoidHom.comap_bot, index_comap, relindex_bot_left]
  rfl
#align subgroup.index_ker Subgroup.index_ker
#align add_subgroup.index_ker AddSubgroup.index_ker

@[to_additive]
theorem relindex_ker {H} [Group H] (f : G →* H) (K : Subgroup G) :
    f.ker.relindex K = Nat.card (f '' K) := by
  rw [← MonoidHom.comap_bot, relindex_comap, relindex_bot_left]
  rfl
#align subgroup.relindex_ker Subgroup.relindex_ker
#align add_subgroup.relindex_ker AddSubgroup.relindex_ker

@[to_additive (attr := simp) card_mul_index]
theorem card_mul_index : Nat.card H * H.index = Nat.card G := by
  rw [← relindex_bot_left, ← index_bot]
  exact relindex_mul_index bot_le
#align subgroup.card_mul_index Subgroup.card_mul_index
#align add_subgroup.card_mul_index AddSubgroup.card_mul_index

@[to_additive]
theorem nat_card_dvd_of_injective {G H : Type _} [Group G] [Group H] (f : G →* H)
    (hf : Function.Injective f) : Nat.card G ∣ Nat.card H := by
  rw [Nat.card_congr (MonoidHom.ofInjective hf).toEquiv]
  exact Dvd.intro f.range.index f.range.card_mul_index
#align subgroup.nat_card_dvd_of_injective Subgroup.nat_card_dvd_of_injective
#align add_subgroup.nat_card_dvd_of_injective AddSubgroup.nat_card_dvd_of_injective

@[to_additive]
theorem nat_card_dvd_of_le (hHK : H ≤ K) : Nat.card H ∣ Nat.card K :=
  nat_card_dvd_of_injective (inclusion hHK) (inclusion_injective hHK)
#align subgroup.nat_card_dvd_of_le Subgroup.nat_card_dvd_of_le
#align add_subgroup.nat_card_dvd_of_le AddSubgroup.nat_card_dvd_of_le

@[to_additive]
theorem nat_card_dvd_of_surjective {G H : Type _} [Group G] [Group H] (f : G →* H)
    (hf : Function.Surjective f) : Nat.card H ∣ Nat.card G := by
  rw [← Nat.card_congr (QuotientGroup.quotientKerEquivOfSurjective f hf).toEquiv]
  exact Dvd.intro_left (Nat.card f.ker) f.ker.card_mul_index
#align subgroup.nat_card_dvd_of_surjective Subgroup.nat_card_dvd_of_surjective
#align add_subgroup.nat_card_dvd_of_surjective AddSubgroup.nat_card_dvd_of_surjective

@[to_additive]
theorem card_dvd_of_surjective {G H : Type _} [Group G] [Group H] [Fintype G] [Fintype H]
    (f : G →* H) (hf : Function.Surjective f) : Fintype.card H ∣ Fintype.card G := by
  simp only [← Nat.card_eq_fintype_card, nat_card_dvd_of_surjective f hf]
#align subgroup.card_dvd_of_surjective Subgroup.card_dvd_of_surjective
#align add_subgroup.card_dvd_of_surjective AddSubgroup.card_dvd_of_surjective

@[to_additive]
theorem index_map {G' : Type _} [Group G'] (f : G →* G') :
    (H.map f).index = (H ⊔ f.ker).index * f.range.index := by
  rw [← comap_map_eq, index_comap, relindex_mul_index (H.map_le_range f)]
#align subgroup.index_map Subgroup.index_map
#align add_subgroup.index_map AddSubgroup.index_map

@[to_additive]
theorem index_map_dvd {G' : Type _} [Group G'] {f : G →* G'} (hf : Function.Surjective f) :
    (H.map f).index ∣ H.index := by
  rw [index_map, f.range_top_of_surjective hf, index_top, mul_one]
  exact index_dvd_of_le le_sup_left
#align subgroup.index_map_dvd Subgroup.index_map_dvd
#align add_subgroup.index_map_dvd AddSubgroup.index_map_dvd

@[to_additive]
theorem dvd_index_map {G' : Type _} [Group G'] {f : G →* G'} (hf : f.ker ≤ H) :
    H.index ∣ (H.map f).index := by
  rw [index_map, sup_of_le_left hf]
  apply dvd_mul_right
#align subgroup.dvd_index_map Subgroup.dvd_index_map
#align add_subgroup.dvd_index_map AddSubgroup.dvd_index_map

@[to_additive]
theorem index_map_eq {G' : Type _} [Group G'] {f : G →* G'} (hf1 : Function.Surjective f)
    (hf2 : f.ker ≤ H) : (H.map f).index = H.index :=
  Nat.dvd_antisymm (H.index_map_dvd hf1) (H.dvd_index_map hf2)
#align subgroup.index_map_eq Subgroup.index_map_eq
#align add_subgroup.index_map_eq AddSubgroup.index_map_eq

@[to_additive]
theorem index_eq_card [Fintype (G ⧸ H)] : H.index = Fintype.card (G ⧸ H) :=
  Nat.card_eq_fintype_card
#align subgroup.index_eq_card Subgroup.index_eq_card
#align add_subgroup.index_eq_card AddSubgroup.index_eq_card

@[to_additive index_mul_card]
theorem index_mul_card [Fintype G] [hH : Fintype H] : H.index * Fintype.card H = Fintype.card G :=
  by
  rw [← relindex_bot_left_eq_card, ← index_bot_eq_card, mul_comm];
    exact relindex_mul_index bot_le
#align subgroup.index_mul_card Subgroup.index_mul_card
#align add_subgroup.index_mul_card AddSubgroup.index_mul_card

@[to_additive]
theorem index_dvd_card [Fintype G] : H.index ∣ Fintype.card G := by
  classical exact ⟨Fintype.card H, H.index_mul_card.symm⟩
#align subgroup.index_dvd_card Subgroup.index_dvd_card
#align add_subgroup.index_dvd_card AddSubgroup.index_dvd_card

variable {H K L}

@[to_additive]
theorem relindex_eq_zero_of_le_left (hHK : H ≤ K) (hKL : K.relindex L = 0) : H.relindex L = 0 :=
  eq_zero_of_zero_dvd (hKL ▸ relindex_dvd_of_le_left L hHK)
#align subgroup.relindex_eq_zero_of_le_left Subgroup.relindex_eq_zero_of_le_left
#align add_subgroup.relindex_eq_zero_of_le_left AddSubgroup.relindex_eq_zero_of_le_left

@[to_additive]
theorem relindex_eq_zero_of_le_right (hKL : K ≤ L) (hHK : H.relindex K = 0) : H.relindex L = 0 :=
  Finite.card_eq_zero_of_embedding (quotientSubgroupOfEmbeddingOfLe H hKL) hHK
#align subgroup.relindex_eq_zero_of_le_right Subgroup.relindex_eq_zero_of_le_right
#align add_subgroup.relindex_eq_zero_of_le_right AddSubgroup.relindex_eq_zero_of_le_right

@[to_additive]
theorem index_eq_zero_of_relindex_eq_zero (h : H.relindex K = 0) : H.index = 0 :=
  H.relindex_top_right.symm.trans (relindex_eq_zero_of_le_right le_top h)
#align subgroup.index_eq_zero_of_relindex_eq_zero Subgroup.index_eq_zero_of_relindex_eq_zero
#align add_subgroup.index_eq_zero_of_relindex_eq_zero AddSubgroup.index_eq_zero_of_relindex_eq_zero

@[to_additive]
theorem relindex_le_of_le_left (hHK : H ≤ K) (hHL : H.relindex L ≠ 0) :
    K.relindex L ≤ H.relindex L :=
  Nat.le_of_dvd (Nat.pos_of_ne_zero hHL) (relindex_dvd_of_le_left L hHK)
#align subgroup.relindex_le_of_le_left Subgroup.relindex_le_of_le_left
#align add_subgroup.relindex_le_of_le_left AddSubgroup.relindex_le_of_le_left

@[to_additive]
theorem relindex_le_of_le_right (hKL : K ≤ L) (hHL : H.relindex L ≠ 0) :
    H.relindex K ≤ H.relindex L :=
  Finite.card_le_of_embedding' (quotientSubgroupOfEmbeddingOfLe H hKL) fun h => (hHL h).elim
#align subgroup.relindex_le_of_le_right Subgroup.relindex_le_of_le_right
#align add_subgroup.relindex_le_of_le_right AddSubgroup.relindex_le_of_le_right

@[to_additive]
theorem relindex_ne_zero_trans (hHK : H.relindex K ≠ 0) (hKL : K.relindex L ≠ 0) :
    H.relindex L ≠ 0 := fun h =>
  mul_ne_zero (mt (relindex_eq_zero_of_le_right (show K ⊓ L ≤ K from inf_le_left)) hHK) hKL
    ((relindex_inf_mul_relindex H K L).trans (relindex_eq_zero_of_le_left inf_le_left h))
#align subgroup.relindex_ne_zero_trans Subgroup.relindex_ne_zero_trans
#align add_subgroup.relindex_ne_zero_trans AddSubgroup.relindex_ne_zero_trans

@[to_additive]
theorem relindex_inf_ne_zero (hH : H.relindex L ≠ 0) (hK : K.relindex L ≠ 0) :
    (H ⊓ K).relindex L ≠ 0 := by
  replace hH : H.relindex (K ⊓ L) ≠ 0 := mt (relindex_eq_zero_of_le_right inf_le_right) hH
  rw [← inf_relindex_right] at hH hK⊢
  rw [inf_assoc]
  exact relindex_ne_zero_trans hH hK
#align subgroup.relindex_inf_ne_zero Subgroup.relindex_inf_ne_zero
#align add_subgroup.relindex_inf_ne_zero AddSubgroup.relindex_inf_ne_zero

@[to_additive]

@[to_additive]
theorem relindex_inf_le : (H ⊓ K).relindex L ≤ H.relindex L * K.relindex L := by
  by_cases h : H.relindex L = 0
  · exact (le_of_eq (relindex_eq_zero_of_le_left inf_le_left h)).trans (zero_le _)
  rw [← inf_relindex_right, inf_assoc, ← relindex_mul_relindex _ _ L inf_le_right inf_le_right,
    inf_relindex_right, inf_relindex_right]
  exact mul_le_mul_right' (relindex_le_of_le_right inf_le_right h) (K.relindex L)
#align subgroup.relindex_inf_le Subgroup.relindex_inf_le
#align add_subgroup.relindex_inf_le AddSubgroup.relindex_inf_le

@[to_additive]
theorem index_inf_le : (H ⊓ K).index ≤ H.index * K.index := by
  simp_rw [← relindex_top_right, relindex_inf_le]
#align subgroup.index_inf_le Subgroup.index_inf_le
#align add_subgroup.index_inf_le AddSubgroup.index_inf_le

@[to_additive]
theorem relindex_infᵢ_ne_zero {ι : Type _} [_hι : Finite ι] {f : ι → Subgroup G}
    (hf : ∀ i, (f i).relindex L ≠ 0) : (⨅ i, f i).relindex L ≠ 0 :=
  haveI := Fintype.ofFinite ι
  (Finset.prod_ne_zero_iff.mpr fun i _hi => hf i) ∘
    Nat.card_pi.symm.trans ∘
      Finite.card_eq_zero_of_embedding (quotientInfᵢSubgroupOfEmbedding f L)
#align subgroup.relindex_infi_ne_zero Subgroup.relindex_infᵢ_ne_zero
#align add_subgroup.relindex_infi_ne_zero AddSubgroup.relindex_infᵢ_ne_zero

@[to_additive]
theorem relindex_infᵢ_le {ι : Type _} [Fintype ι] (f : ι → Subgroup G) :
    (⨅ i, f i).relindex L ≤ ∏ i, (f i).relindex L :=
  le_of_le_of_eq
    (Finite.card_le_of_embedding' (quotientInfᵢSubgroupOfEmbedding f L) fun h =>
      let ⟨i, _hi, h⟩ := Finset.prod_eq_zero_iff.mp (Nat.card_pi.symm.trans h)
      relindex_eq_zero_of_le_left (infᵢ_le f i) h)
    Nat.card_pi
#align subgroup.relindex_infi_le Subgroup.relindex_infᵢ_le
#align add_subgroup.relindex_infi_le AddSubgroup.relindex_infᵢ_le

@[to_additive]
theorem index_infᵢ_ne_zero {ι : Type _} [Finite ι] {f : ι → Subgroup G}
    (hf : ∀ i, (f i).index ≠ 0) : (⨅ i, f i).index ≠ 0 := by
  simp_rw [← relindex_top_right] at hf⊢
  exact relindex_infᵢ_ne_zero hf
#align subgroup.index_infi_ne_zero Subgroup.index_infᵢ_ne_zero
#align add_subgroup.index_infi_ne_zero AddSubgroup.index_infᵢ_ne_zero

@[to_additive]
theorem index_infᵢ_le {ι : Type _} [Fintype ι] (f : ι → Subgroup G) :
    (⨅ i, f i).index ≤ ∏ i, (f i).index := by simp_rw [← relindex_top_right, relindex_infᵢ_le]
#align subgroup.index_infi_le Subgroup.index_infᵢ_le
#align add_subgroup.index_infi_le AddSubgroup.index_infᵢ_le

--porting note: had to replace `Cardinal.toNat_eq_one_iff_unique` with `Nat.card_eq_one_iff_unique`
@[to_additive (attr := simp) index_eq_one]
theorem index_eq_one : H.index = 1 ↔ H = ⊤ :=
  ⟨fun h =>
    QuotientGroup.subgroup_eq_top_of_subsingleton H (Nat.card_eq_one_iff_unique.mp h).1,
    fun h => (congr_arg index h).trans index_top⟩
#align subgroup.index_eq_one Subgroup.index_eq_one
#align add_subgroup.index_eq_one AddSubgroup.index_eq_one

@[to_additive (attr := simp) relindex_eq_one]
theorem relindex_eq_one : H.relindex K = 1 ↔ K ≤ H :=
  index_eq_one.trans subgroupOf_eq_top
#align subgroup.relindex_eq_one Subgroup.relindex_eq_one
#align add_subgroup.relindex_eq_one AddSubgroup.relindex_eq_one

@[to_additive (attr := simp) card_eq_one]
theorem card_eq_one : Nat.card H = 1 ↔ H = ⊥ :=
  H.relindex_bot_left ▸ relindex_eq_one.trans le_bot_iff
#align subgroup.card_eq_one Subgroup.card_eq_one
#align add_subgroup.card_eq_one AddSubgroup.card_eq_one

@[to_additive]
theorem index_ne_zero_of_finite [hH : Finite (G ⧸ H)] : H.index ≠ 0 := by
  cases nonempty_fintype (G ⧸ H)
  rw [index_eq_card]
  exact Fintype.card_ne_zero
#align subgroup.index_ne_zero_of_finite Subgroup.index_ne_zero_of_finite
#align add_subgroup.index_ne_zero_of_finite AddSubgroup.index_ne_zero_of_finite

--porting note: changed due to error with `Cardinal.toNat_apply_of_aleph0_le`
/-- Finite index implies finite quotient. -/
@[to_additive "Finite index implies finite quotient."]
noncomputable def fintypeOfIndexNeZero (hH : H.index ≠ 0) : Fintype (G ⧸ H) :=
  @Fintype.ofFinite _ (Nat.finite_of_card_ne_zero hH)
#align subgroup.fintype_of_index_ne_zero Subgroup.fintypeOfIndexNeZero
#align add_subgroup.fintype_of_index_ne_zero AddSubgroup.fintypeOfIndexNeZero

@[to_additive one_lt_index_of_ne_top]
theorem one_lt_index_of_ne_top [Finite (G ⧸ H)] (hH : H ≠ ⊤) : 1 < H.index :=
  Nat.one_lt_iff_ne_zero_and_ne_one.mpr ⟨index_ne_zero_of_finite, mt index_eq_one.mp hH⟩
#align subgroup.one_lt_index_of_ne_top Subgroup.one_lt_index_of_ne_top
#align add_subgroup.one_lt_index_of_ne_top AddSubgroup.one_lt_index_of_ne_top

section FiniteIndex

variable (H K)

/-- Typeclass for finite index subgroups. -/
class FiniteIndex : Prop where
  /-- The subgroup has finite index -/
  finiteIndex : H.index ≠ 0
#align subgroup.finite_index Subgroup.FiniteIndex

/-- Typeclass for finite index subgroups. -/
class _root_.AddSubgroup.FiniteIndex {G : Type _} [AddGroup G] (H : AddSubgroup G) : Prop where
  /-- The additive subgroup has finite index -/
  finiteIndex : H.index ≠ 0
#align add_subgroup.finite_index AddSubgroup.FiniteIndex

/-- A finite index subgroup has finite quotient. -/
@[to_additive "A finite index subgroup has finite quotient"]
noncomputable def fintypeQuotientOfFiniteIndex [FiniteIndex H] : Fintype (G ⧸ H) :=
  fintypeOfIndexNeZero FiniteIndex.finiteIndex
#align subgroup.fintype_quotient_of_finite_index Subgroup.fintypeQuotientOfFiniteIndex
#align add_subgroup.fintype_quotient_of_finite_index AddSubgroup.fintypeQuotientOfFiniteIndex

@[to_additive]
instance finite_quotient_of_finiteIndex [FiniteIndex H] : Finite (G ⧸ H) :=
  H.fintypeQuotientOfFiniteIndex.finite
#align subgroup.finite_quotient_of_finite_index Subgroup.finite_quotient_of_finiteIndex
#align add_subgroup.finite_quotient_of_finite_index AddSubgroup.finite_quotient_of_finiteIndex

@[to_additive]
theorem finiteIndex_of_finite_quotient [Finite (G ⧸ H)] : FiniteIndex H :=
  ⟨index_ne_zero_of_finite⟩
#align subgroup.finite_index_of_finite_quotient Subgroup.finiteIndex_of_finite_quotient
#align add_subgroup.finite_index_of_finite_quotient AddSubgroup.finiteIndex_of_finite_quotient

--porting note: had to manually provide finite instance for quotient when it should be automatic
@[to_additive]
instance (priority := 100) finiteIndex_of_finite [Finite G] : FiniteIndex H :=
  @finiteIndex_of_finite_quotient _ _ H (Quotient.finite _)
#align subgroup.finite_index_of_finite Subgroup.finiteIndex_of_finite
#align add_subgroup.finite_index_of_finite AddSubgroup.finiteIndex_of_finite

@[to_additive]
instance : FiniteIndex (⊤ : Subgroup G) :=
  ⟨ne_of_eq_of_ne index_top one_ne_zero⟩

@[to_additive]
instance [FiniteIndex H] [FiniteIndex K] : FiniteIndex (H ⊓ K) :=
  ⟨index_inf_ne_zero FiniteIndex.finiteIndex FiniteIndex.finiteIndex⟩

variable {H K}

@[to_additive]
theorem finiteIndex_of_le [FiniteIndex H] (h : H ≤ K) : FiniteIndex K :=
  ⟨ne_zero_of_dvd_ne_zero FiniteIndex.finiteIndex (index_dvd_of_le h)⟩
#align subgroup.finite_index_of_le Subgroup.finiteIndex_of_le
#align add_subgroup.finite_index_of_le AddSubgroup.finiteIndex_of_le

variable (H K)

@[to_additive]
instance finiteIndex_ker {G' : Type _} [Group G'] (f : G →* G') [Finite f.range] :
    f.ker.FiniteIndex :=
  @finiteIndex_of_finite_quotient G _ f.ker
    (Finite.of_equiv f.range (QuotientGroup.quotientKerEquivRange f).symm)
#align subgroup.finite_index_ker Subgroup.finiteIndex_ker
#align add_subgroup.finite_index_ker AddSubgroup.finiteIndex_ker

instance finiteIndex_normalCore [H.FiniteIndex] : H.normalCore.FiniteIndex := by
  rw [normalCore_eq_ker]
  infer_instance
#align subgroup.finite_index_normal_core Subgroup.finiteIndex_normalCore

variable (G)

instance finiteIndex_center [Finite (commutatorSet G)] [Group.Fg G] : FiniteIndex (center G) := by
  obtain ⟨S, -, hS⟩ := Group.rank_spec G
  exact ⟨mt (Finite.card_eq_zero_of_embedding (quotientCenterEmbedding hS)) Finite.card_pos.ne'⟩
#align subgroup.finite_index_center Subgroup.finiteIndex_center

theorem index_center_le_pow [Finite (commutatorSet G)] [Group.Fg G] :
    (center G).index ≤ Nat.card (commutatorSet G) ^ Group.rank G := by
  obtain ⟨S, hS1, hS2⟩ := Group.rank_spec G
  rw [← hS1, ← Fintype.card_coe, ← Nat.card_eq_fintype_card, ← Finset.coe_sort_coe, ← Nat.card_fun]
  exact Finite.card_le_of_embedding (quotientCenterEmbedding hS2)
#align subgroup.index_center_le_pow Subgroup.index_center_le_pow

end FiniteIndex

end Subgroup


import tactic
open_locale big_operators
open finset

#check mul_add
#check sum_range_succ
#check nat.succ_eq_add_one

theorem sum_id (n : ℕ) : ∑ i in range (n + 1), i = n * (n + 1) / 2 :=
begin
  symmetry,
  apply nat.div_eq_of_eq_mul_right (by norm_num : 0 < 2),
  induction n with n ih,
   { simp },
  rw [finset.sum_range_succ, mul_add 2, ←ih, nat.succ_eq_add_one],
  ring,
end

example (n : ℕ) : 2 * ∑ j in range (n + 1), j = n * (n + 1) :=
begin
  induction n with k h,
  { simp },
  { rw sum_range_succ,
    rw mul_add,
    rw h,
    rw nat.succ_eq_add_one,
    ring },
end


/-
Copyright (c) 2016 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad

Examples from the tutorial.
-/
import tactic.finish
open auto

section
variables p q r s : Prop

-- commutativity of ∧ and ∨
example : p ∧ q ↔ q ∧ p := by finish
example : p ∨ q ↔ q ∨ p := by finish

-- associativity of ∧ and ∨
example : (p ∧ q) ∧ r ↔ p ∧ (q ∧ r) := by finish
example : (p ∨ q) ∨ r ↔ p ∨ (q ∨ r) := by finish

-- distributivity
example : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) := by finish [iff_def]
example : p ∨ (q ∧ r) ↔ (p ∨ q) ∧ (p ∨ r) := by finish [iff_def]

-- other properties
example : (p → (q → r)) ↔ (p ∧ q → r) := by finish [iff_def]
example : ((p ∨ q) → r) ↔ (p → r) ∧ (q → r) := by finish [iff_def]
example : ¬(p ∨ q) ↔ ¬p ∧ ¬q := by finish
example : ¬p ∨ ¬q → ¬(p ∧ q) := by finish
example : ¬(p ∧ ¬ p) := by finish
example : p ∧ ¬q → ¬(p → q) := by finish
example : ¬p → (p → q) := by finish
example : (¬p ∨ q) → (p → q) := by finish
example : p ∨ false ↔ p := by finish
example : p ∧ false ↔ false := by finish
example : ¬(p ↔ ¬p) := by finish
example : (p → q) → (¬q → ¬p) := by finish

-- these require classical reasoning
example : (p → r ∨ s) → ((p → r) ∨ (p → s)) := by finish
example : ¬(p ∧ q) → ¬p ∨ ¬q := by finish
example : ¬(p → q) → p ∧ ¬q := by finish
example : (p → q) → (¬p ∨ q) := by finish
example : (¬q → ¬p) → (p → q) := by finish
example : p ∨ ¬p := by finish
example : (((p → q) → p) → p) := by finish
end

section

variables (A : Type) (p q : A → Prop)
variable a : A
variable r : Prop

example : (∃ x : A, r) → r := by finish
-- TODO(Jeremy): can we get these automatically?
example (a : A) : r → (∃ x : A, r) := begin safe; apply_assumption; assumption end
example : (∃ x, p x ∧ r) ↔ (∃ x, p x) ∧ r := by finish

theorem foo': (∃ x, p x ∨ q x) ↔ (∃ x, p x) ∨ (∃ x, q x) :=
by finish [iff_def]

example (h : ∀ x, ¬ ¬ p x) : p a := by finish
example (h : ∀ x, ¬ ¬ p x) : ∀ x, p x := by finish

example : (∀ x, p x) ↔ ¬ (∃ x, ¬ p x) := by finish

example : (∃ x, p x) ↔ ¬ (∀ x, ¬ p x) := by finish
example : (¬ ∃ x, p x) ↔ (∀ x, ¬ p x) := by finish
example : (¬ ∀ x, p x) ↔ (∃ x, ¬ p x) := by finish
example : (∃ x, ¬ p x) → (¬ ∀ x, p x) := by finish

example : (∀ x, p x → r) ↔ (∃ x, p x) → r := by finish [iff_def]
-- TODO(Jeremy): can we get these automatically?
example (a : A) : (∃ x, p x → r) ↔ (∀ x, p x) → r := begin safe [iff_def]; exact h a end
example (a : A) : (∃ x, r → p x) ↔ (r → ∃ x, p x) := begin safe [iff_def]; exact h a end

example : (∃ x, p x → r) → (∀ x, p x) → r := by finish
example : (∃ x, r → p x) → (r → ∃ x, p x) := by finish

end


/-
Copyright (c) 2020 Aaron Anderson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Aaron Anderson
-/
import algebra.big_operators.order
import data.nat.interval
import data.nat.prime

/-!
# Divisor finsets

This file defines sets of divisors of a natural number. This is particularly useful as background
for defining Dirichlet convolution.

## Main Definitions
Let `n : ℕ`. All of the following definitions are in the `nat` namespace:
 * `divisors n` is the `finset` of natural numbers that divide `n`.
 * `proper_divisors n` is the `finset` of natural numbers that divide `n`, other than `n`.
 * `divisors_antidiagonal n` is the `finset` of pairs `(x,y)` such that `x * y = n`.
 * `perfect n` is true when `n` is positive and the sum of `proper_divisors n` is `n`.

## Implementation details
 * `divisors 0`, `proper_divisors 0`, and `divisors_antidiagonal 0` are defined to be `∅`.

## Tags
divisors, perfect numbers

-/

open_locale classical
open_locale big_operators
open finset

namespace nat
variable (n : ℕ)

/-- `divisors n` is the `finset` of divisors of `n`. As a special case, `divisors 0 = ∅`. -/
def divisors : finset ℕ := finset.filter (λ x : ℕ, x ∣ n) (finset.Ico 1 (n + 1))

/-- `proper_divisors n` is the `finset` of divisors of `n`, other than `n`.
  As a special case, `proper_divisors 0 = ∅`. -/
def proper_divisors : finset ℕ := finset.filter (λ x : ℕ, x ∣ n) (finset.Ico 1 n)

/-- `divisors_antidiagonal n` is the `finset` of pairs `(x,y)` such that `x * y = n`.
  As a special case, `divisors_antidiagonal 0 = ∅`. -/
def divisors_antidiagonal : finset (ℕ × ℕ) :=
((finset.Ico 1 (n + 1)).product (finset.Ico 1 (n + 1))).filter (λ x, x.fst * x.snd = n)

variable {n}

lemma proper_divisors.not_self_mem : ¬ n ∈ proper_divisors n :=
begin
  rw proper_divisors,
  simp,
end

@[simp]
lemma mem_proper_divisors {m : ℕ} : n ∈ proper_divisors m ↔ n ∣ m ∧ n < m :=
begin
  rw [proper_divisors, finset.mem_filter, finset.mem_Ico, and_comm],
  apply and_congr_right,
  rw and_iff_right_iff_imp,
  intros hdvd hlt,
  apply nat.pos_of_ne_zero _,
  rintro rfl,
  rw zero_dvd_iff.1 hdvd at hlt,
  apply lt_irrefl 0 hlt,
end

lemma divisors_eq_proper_divisors_insert_self_of_pos (h : 0 < n):
  divisors n = has_insert.insert n (proper_divisors n) :=
by rw [divisors, proper_divisors, Ico_succ_right_eq_insert_Ico h, finset.filter_insert,
  if_pos (dvd_refl n)]

@[simp]
lemma mem_divisors {m : ℕ} :
  n ∈ divisors m ↔ (n ∣ m ∧ m ≠ 0) :=
begin
  cases m,
  { simp [divisors] },
  simp only [divisors, finset.mem_Ico, ne.def, finset.mem_filter, succ_ne_zero, and_true,
             and_iff_right_iff_imp, not_false_iff],
  intro hdvd,
  split,
  { apply nat.pos_of_ne_zero,
    rintro rfl,
    apply nat.succ_ne_zero,
    rwa zero_dvd_iff at hdvd },
  { rw nat.lt_succ_iff,
    apply nat.le_of_dvd (nat.succ_pos m) hdvd }
end

lemma mem_divisors_self (n : ℕ) (h : n ≠ 0) : n ∈ n.divisors := mem_divisors.2 ⟨dvd_rfl, h⟩

lemma dvd_of_mem_divisors {m : ℕ} (h : n ∈ divisors m) : n ∣ m :=
begin
  cases m,
  { apply dvd_zero },
  { simp [mem_divisors.1 h], }
end

@[simp]
lemma mem_divisors_antidiagonal {x : ℕ × ℕ} :
  x ∈ divisors_antidiagonal n ↔ x.fst * x.snd = n ∧ n ≠ 0 :=
begin
  simp only [divisors_antidiagonal, finset.mem_Ico, ne.def, finset.mem_filter, finset.mem_product],
  rw and_comm,
  apply and_congr_right,
  rintro rfl,
  split; intro h,
  { contrapose! h, simp [h], },
  { rw [nat.lt_add_one_iff, nat.lt_add_one_iff],
    rw [mul_eq_zero, decidable.not_or_iff_and_not] at h,
    simp only [succ_le_of_lt (nat.pos_of_ne_zero h.1), succ_le_of_lt (nat.pos_of_ne_zero h.2),
               true_and],
    exact ⟨le_mul_of_pos_right (nat.pos_of_ne_zero h.2),
      le_mul_of_pos_left (nat.pos_of_ne_zero h.1)⟩ }
end

variable {n}

lemma divisor_le {m : ℕ}:
n ∈ divisors m → n ≤ m :=
begin
  cases m,
  { simp },
  simp only [mem_divisors, m.succ_ne_zero, and_true, ne.def, not_false_iff],
  exact nat.le_of_dvd (nat.succ_pos m),
end

lemma divisors_subset_of_dvd {m : ℕ} (hzero : n ≠ 0) (h : m ∣ n) : divisors m ⊆ divisors n :=
finset.subset_iff.2 $ λ x hx, nat.mem_divisors.mpr (⟨(nat.mem_divisors.mp hx).1.trans h, hzero⟩)

lemma divisors_subset_proper_divisors {m : ℕ} (hzero : n ≠ 0) (h : m ∣ n) (hdiff : m ≠ n) :
  divisors m ⊆ proper_divisors n :=
begin
  apply finset.subset_iff.2,
  intros x hx,
  exact nat.mem_proper_divisors.2 (⟨(nat.mem_divisors.1 hx).1.trans h,
    lt_of_le_of_lt (divisor_le hx) (lt_of_le_of_ne (divisor_le (nat.mem_divisors.2
    ⟨h, hzero⟩)) hdiff)⟩)
end

@[simp]
lemma divisors_zero : divisors 0 = ∅ := by { ext, simp }

@[simp]
lemma proper_divisors_zero : proper_divisors 0 = ∅ := by { ext, simp }

lemma proper_divisors_subset_divisors : proper_divisors n ⊆ divisors n :=
begin
  cases n,
  { simp },
  rw [divisors_eq_proper_divisors_insert_self_of_pos (nat.succ_pos _)],
  apply subset_insert,
end

@[simp]
lemma divisors_one : divisors 1 = {1} := by { ext, simp }

@[simp]
lemma proper_divisors_one : proper_divisors 1 = ∅ :=
begin
  ext,
  simp only [finset.not_mem_empty, nat.dvd_one, not_and, not_lt, mem_proper_divisors, iff_false],
  apply ge_of_eq,
end

lemma pos_of_mem_divisors {m : ℕ} (h : m ∈ n.divisors) : 0 < m :=
begin
  cases m,
  { rw [mem_divisors, zero_dvd_iff] at h,
    rcases h with ⟨rfl, h⟩,
    exfalso,
    apply h rfl },
  apply nat.succ_pos,
end

lemma pos_of_mem_proper_divisors {m : ℕ} (h : m ∈ n.proper_divisors) : 0 < m :=
pos_of_mem_divisors (proper_divisors_subset_divisors h)

lemma one_mem_proper_divisors_iff_one_lt :
  1 ∈ n.proper_divisors ↔ 1 < n :=
by rw [mem_proper_divisors, and_iff_right (one_dvd _)]

@[simp]
lemma divisors_antidiagonal_zero : divisors_antidiagonal 0 = ∅ := by { ext, simp }

@[simp]
lemma divisors_antidiagonal_one : divisors_antidiagonal 1 = {(1,1)} :=
by { ext, simp [nat.mul_eq_one_iff, prod.ext_iff], }

lemma swap_mem_divisors_antidiagonal {x : ℕ × ℕ} (h : x ∈ divisors_antidiagonal n) :
  x.swap ∈ divisors_antidiagonal n :=
begin
  rw [mem_divisors_antidiagonal, mul_comm] at h,
  simp [h.1, h.2],
end

lemma snd_mem_divisors_of_mem_antidiagonal {x : ℕ × ℕ} (h : x ∈ divisors_antidiagonal n) :
  x.snd ∈ divisors n :=
begin
  rw mem_divisors_antidiagonal at h,
  simp [dvd.intro_left _ h.1, h.2],
end

@[simp]
lemma map_swap_divisors_antidiagonal :
  (divisors_antidiagonal n).map ⟨prod.swap, prod.swap_right_inverse.injective⟩
  = divisors_antidiagonal n :=
begin
  ext,
  simp only [exists_prop, mem_divisors_antidiagonal, finset.mem_map, function.embedding.coe_fn_mk,
             ne.def, prod.swap_prod_mk, prod.exists],
  split,
  { rintros ⟨x, y, ⟨⟨rfl, h⟩, rfl⟩⟩,
    simp [mul_comm, h], },
  { rintros ⟨rfl, h⟩,
    use [a.snd, a.fst],
    rw mul_comm,
    simp [h] }
end

lemma sum_divisors_eq_sum_proper_divisors_add_self :
∑ i in divisors n, i = ∑ i in proper_divisors n, i + n :=
begin
  cases n,
  { simp },
  { rw [divisors_eq_proper_divisors_insert_self_of_pos (nat.succ_pos _),
        finset.sum_insert (proper_divisors.not_self_mem), add_comm] }
end

/-- `n : ℕ` is perfect if and only the sum of the proper divisors of `n` is `n` and `n`
  is positive. -/
def perfect (n : ℕ) : Prop := (∑ i in proper_divisors n, i = n) ∧ 0 < n

theorem perfect_iff_sum_proper_divisors (h : 0 < n) :
  perfect n ↔ ∑ i in proper_divisors n, i = n := and_iff_left h

theorem perfect_iff_sum_divisors_eq_two_mul (h : 0 < n) :
  perfect n ↔ ∑ i in divisors n, i = 2 * n :=
begin
  rw [perfect_iff_sum_proper_divisors h, sum_divisors_eq_sum_proper_divisors_add_self, two_mul],
  split; intro h,
  { rw h },
  { apply add_right_cancel h }
end

lemma mem_divisors_prime_pow {p : ℕ} (pp : p.prime) (k : ℕ) {x : ℕ} :
  x ∈ divisors (p ^ k) ↔ ∃ (j : ℕ) (H : j ≤ k), x = p ^ j :=
by rw [mem_divisors, nat.dvd_prime_pow pp, and_iff_left (ne_of_gt (pow_pos pp.pos k))]

lemma prime.divisors {p : ℕ} (pp : p.prime) :
  divisors p = {1, p} :=
begin
  ext,
  simp only [pp.ne_zero, and_true, ne.def, not_false_iff, finset.mem_insert,
    finset.mem_singleton, mem_divisors],
  refine ⟨pp.2 a, λ h, _⟩,
  rcases h; subst h,
  apply one_dvd,
end

lemma prime.proper_divisors {p : ℕ} (pp : p.prime) :
  proper_divisors p = {1} :=
by rw [← erase_insert (proper_divisors.not_self_mem),
    ← divisors_eq_proper_divisors_insert_self_of_pos pp.pos,
    pp.divisors, insert_singleton_comm, erase_insert (λ con, pp.ne_one (mem_singleton.1 con))]

lemma divisors_prime_pow {p : ℕ} (pp : p.prime) (k : ℕ) :
  divisors (p ^ k) = (finset.range (k + 1)).map ⟨pow p, pow_right_injective pp.two_le⟩ :=
by { ext, simp [mem_divisors_prime_pow, pp, nat.lt_succ_iff, @eq_comm _ a] }

lemma eq_proper_divisors_of_subset_of_sum_eq_sum {s : finset ℕ} (hsub : s ⊆ n.proper_divisors) :
  ∑ x in s, x = ∑ x in n.proper_divisors, x → s = n.proper_divisors :=
begin
  cases n,
  { rw [proper_divisors_zero, subset_empty] at hsub,
    simp [hsub] },
  classical,
  rw [← sum_sdiff hsub],
  intros h,
  apply subset.antisymm hsub,
  rw [← sdiff_eq_empty_iff_subset],
  contrapose h,
  rw [← ne.def, ← nonempty_iff_ne_empty] at h,
  apply ne_of_lt,
  rw [← zero_add (∑ x in s, x), ← add_assoc, add_zero],
  apply add_lt_add_right,
  have hlt := sum_lt_sum_of_nonempty h (λ x hx, pos_of_mem_proper_divisors (sdiff_subset _ _ hx)),
  simp only [sum_const_zero] at hlt,
  apply hlt
end

lemma sum_proper_divisors_dvd (h : ∑ x in n.proper_divisors, x ∣ n) :
  (∑ x in n.proper_divisors, x = 1) ∨ (∑ x in n.proper_divisors, x = n) :=
begin
  cases n,
  { simp },
  cases n,
  { contrapose! h,
    simp, },
  rw or_iff_not_imp_right,
  intro ne_n,
  have hlt : ∑ x in n.succ.succ.proper_divisors, x < n.succ.succ :=
    lt_of_le_of_ne (nat.le_of_dvd (nat.succ_pos _) h) ne_n,
  symmetry,
  rw [← mem_singleton, eq_proper_divisors_of_subset_of_sum_eq_sum (singleton_subset_iff.2
        (mem_proper_divisors.2 ⟨h, hlt⟩)) sum_singleton, mem_proper_divisors],
  refine ⟨one_dvd _, nat.succ_lt_succ (nat.succ_pos _)⟩,
end

@[simp, to_additive]
lemma prime.prod_proper_divisors {α : Type*} [comm_monoid α] {p : ℕ} {f : ℕ → α} (h : p.prime) :
  ∏ x in p.proper_divisors, f x = f 1 :=
by simp [h.proper_divisors]

@[simp, to_additive]
lemma prime.prod_divisors {α : Type*} [comm_monoid α] {p : ℕ} {f : ℕ → α} (h : p.prime) :
  ∏ x in p.divisors, f x = f p * f 1 :=
by rw [divisors_eq_proper_divisors_insert_self_of_pos h.pos,
       prod_insert proper_divisors.not_self_mem, h.prod_proper_divisors]

lemma proper_divisors_eq_singleton_one_iff_prime :
  n.proper_divisors = {1} ↔ n.prime :=
⟨λ h, begin
  have h1 := mem_singleton.2 rfl,
  rw [← h, mem_proper_divisors] at h1,
  refine ⟨h1.2, _⟩,
  intros m hdvd,
  rw [← mem_singleton, ← h, mem_proper_divisors],
  cases lt_or_eq_of_le (nat.le_of_dvd (lt_trans (nat.succ_pos _) h1.2) hdvd),
  { left,
    exact ⟨hdvd, h_1⟩ },
  { right,
    exact h_1 }
end, prime.proper_divisors⟩

lemma sum_proper_divisors_eq_one_iff_prime :
  ∑ x in n.proper_divisors, x = 1 ↔ n.prime :=
begin
  cases n,
  { simp [nat.not_prime_zero] },
  cases n,
  { simp [nat.not_prime_one] },
  rw [← proper_divisors_eq_singleton_one_iff_prime],
  refine ⟨λ h, _, λ h, h.symm ▸ sum_singleton⟩,
  rw [@eq_comm (finset ℕ) _ _],
  apply eq_proper_divisors_of_subset_of_sum_eq_sum
    (singleton_subset_iff.2 (one_mem_proper_divisors_iff_one_lt.2 (succ_lt_succ (nat.succ_pos _))))
    (eq.trans sum_singleton h.symm)
end

lemma mem_proper_divisors_prime_pow {p : ℕ} (pp : p.prime) (k : ℕ) {x : ℕ} :
  x ∈ proper_divisors (p ^ k) ↔ ∃ (j : ℕ) (H : j < k), x = p ^ j :=
begin
  rw [mem_proper_divisors, nat.dvd_prime_pow pp, ← exists_and_distrib_right],
  simp only [exists_prop, and_assoc],
  apply exists_congr,
  intro a,
  split; intro h,
  { rcases h with ⟨h_left, rfl, h_right⟩,
    rwa pow_lt_pow_iff pp.one_lt at h_right,
    simpa, },
  { rcases h with ⟨h_left, rfl⟩,
    rwa pow_lt_pow_iff pp.one_lt,
    simp [h_left, le_of_lt], },
end

lemma proper_divisors_prime_pow {p : ℕ} (pp : p.prime) (k : ℕ) :
  proper_divisors (p ^ k) = (finset.range k).map ⟨pow p, pow_right_injective pp.two_le⟩ :=
by { ext, simp [mem_proper_divisors_prime_pow, pp, nat.lt_succ_iff, @eq_comm _ a], }

@[simp, to_additive]
lemma prod_proper_divisors_prime_pow {α : Type*} [comm_monoid α] {k p : ℕ} {f : ℕ → α}
  (h : p.prime) : ∏ x in (p ^ k).proper_divisors, f x = ∏ x in range k, f (p ^ x) :=
by simp [h, proper_divisors_prime_pow]

@[simp, to_additive]
lemma prod_divisors_prime_pow {α : Type*} [comm_monoid α] {k p : ℕ} {f : ℕ → α} (h : p.prime) :
  ∏ x in (p ^ k).divisors, f x = ∏ x in range (k + 1), f (p ^ x) :=
by simp [h, divisors_prime_pow]

@[simp]
lemma filter_dvd_eq_divisors {n : ℕ} (h : n ≠ 0) :
  finset.filter (λ (x : ℕ), x ∣ n) (finset.range (n : ℕ).succ) = (n : ℕ).divisors :=
begin
  apply finset.ext,
  simp only [h, mem_filter, and_true, and_iff_right_iff_imp, cast_id, mem_range, ne.def,
  not_false_iff, mem_divisors],
  intros a ha,
  exact nat.lt_succ_of_le (nat.divisor_le (nat.mem_divisors.2 ⟨ha, h⟩))
end

/-- The factors of `n` are the prime divisors -/
lemma prime_divisors_eq_to_filter_divisors_prime (n : ℕ) :
  n.factors.to_finset = (divisors n).filter prime :=
begin
  rcases n.eq_zero_or_pos with rfl | hn,
  { simp },
  { ext q,
    simpa [hn, hn.ne', mem_factors] using and_comm (prime q) (q ∣ n) }
end

end nat


/-
Copyright (c) 2018 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Isometries of emetric and metric spaces
Authors: Sébastien Gouëzel
We define isometries, i.e., maps between emetric spaces that preserve
the edistance (on metric spaces, these are exactly the maps that preserve distances),
and prove their basic properties. We also introduce isometric bijections.
-/

import topology.metric_space.basic topology.instances.real

noncomputable theory

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

open function set

/-- An isometry (also known as isometric embedding) is a map preserving the edistance
between emetric spaces, or equivalently the distance between metric space.  -/
def isometry [emetric_space α] [emetric_space β] (f : α → β) : Prop :=
∀x1 x2 : α, edist (f x1) (f x2) = edist x1 x2

/-- On metric spaces, a map is an isometry if and only if it preserves distances. -/
lemma isometry_emetric_iff_metric [metric_space α] [metric_space β] {f : α → β} :
  isometry f ↔ (∀x y, dist (f x) (f y) = dist x y) :=
⟨assume H x y, by simp [dist_edist, H x y],
assume H x y, by simp [edist_dist, H x y]⟩

/-- An isometry preserves edistances. -/
theorem isometry.edist_eq [emetric_space α] [emetric_space β] {f : α → β} {x y : α} (hf : isometry f) :
  edist (f x) (f y) = edist x y :=
hf x y

/-- An isometry preserves distances. -/
theorem isometry.dist_eq [metric_space α] [metric_space β] {f : α → β} {x y : α} (hf : isometry f) :
  dist (f x) (f y) = dist x y :=
by rw [dist_edist, dist_edist, hf]

section emetric_isometry

variables [emetric_space α] [emetric_space β] [emetric_space γ]
variables {f : α → β} {x y z : α}  {s : set α}

/-- An isometry is injective -/
lemma isometry.injective (h : isometry f) : injective f :=
λx y hxy, edist_eq_zero.1 $
calc edist x y = edist (f x) (f y) : (h x y).symm
         ...   = 0 : by rw [hxy]; simp

/-- Any map on a subsingleton is an isometry -/
theorem isometry_subsingleton [subsingleton α] : isometry f :=
λx y, by rw subsingleton.elim x y; simp

/-- The identity is an isometry -/
lemma isometry_id : isometry (id : α → α) :=
λx y, rfl

/-- The composition of isometries is an isometry -/
theorem isometry.comp {g : β → γ} (hf : isometry f) (hg : isometry g) : isometry (g ∘ f) :=
assume x y, calc
  edist ((g ∘ f) x) ((g ∘ f) y) = edist (f x) (f y) : hg _ _
                            ... = edist x y : hf _ _

/-- An isometry is an embedding -/
theorem isometry.uniform_embedding (hf : isometry f) : uniform_embedding f :=
begin
  refine emetric.uniform_embedding_iff.2 ⟨_, _, _⟩,
  { assume x y hxy,
    have : edist (f x) (f y) = 0 := by simp [hxy],
    have : edist x y = 0 :=
      begin have A := hf x y, rwa this at A, exact eq.symm A end,
    by simpa using this },
  { rw emetric.uniform_continuous_iff,
    assume ε εpos,
    existsi [ε, εpos],
    simp [hf.edist_eq] },
  { assume δ δpos,
    existsi [δ, δpos],
    simp [hf.edist_eq] }
end

/-- An isometry is continuous. -/
lemma isometry.continuous (hf : isometry f) : continuous f :=
hf.uniform_embedding.embedding.continuous

/-- The inverse of an isometry is an isometry. -/
lemma isometry.inv (e : α ≃ β) (h : isometry e.to_fun) : isometry e.inv_fun :=
λx y, by rw [← h, e.right_inv _, e.right_inv _]

/-- Isometries preserve the diameter -/
lemma emetric.isometry.diam_image (hf : isometry f) {s : set α}:
  emetric.diam (f '' s) = emetric.diam s :=
begin
  refine le_antisymm _ _,
  { apply lattice.Sup_le _,
    simp only [and_imp, set.mem_image, set.mem_prod, exists_imp_distrib, prod.exists],
    assume b x x' z zs xz z' z's x'z' hb,
    rw [← hb, ← xz, ← x'z', hf z z'],
    exact emetric.edist_le_diam_of_mem zs z's },
  { apply lattice.Sup_le _,
    simp only [and_imp, set.mem_image, set.mem_prod, exists_imp_distrib, prod.exists],
    assume b x x' xs x's hb,
    rw [← hb, ← hf x x'],
    exact emetric.edist_le_diam_of_mem (mem_image_of_mem _ xs) (mem_image_of_mem _ x's) }
end

/-- The injection from a subtype is an isometry -/
lemma isometry_subtype_val {s : set α} : isometry (subtype.val : s → α) :=
λx y, rfl

end emetric_isometry --section

/-- An isometry preserves the diameter in metric spaces -/
lemma metric.isometry.diam_image [metric_space α] [metric_space β]
  {f : α → β} {s : set α} (hf : isometry f) : metric.diam (f '' s) = metric.diam s :=
by rw [metric.diam, metric.diam, emetric.isometry.diam_image hf]

/-- α and β are isometric if there is an isometric bijection between them. -/
structure isometric (α : Type*) (β : Type*) [emetric_space α] [emetric_space β]
  extends α ≃ β :=
(isometry_to_fun  : isometry to_fun)
(isometry_inv_fun : isometry inv_fun)

infix ` ≃ᵢ`:50 := isometric

namespace isometric
variables [emetric_space α] [emetric_space β] [emetric_space γ]

instance : has_coe_to_fun (α ≃ᵢ β) := ⟨λ_, α → β, λe, e.to_equiv⟩

lemma coe_eq_to_equiv (h : α ≃ᵢ β) (a : α) : h a = h.to_equiv a := rfl

protected def to_homeomorph (h : α ≃ᵢ β) : α ≃ₜ β :=
{ continuous_to_fun  := (isometry_to_fun h).continuous,
  continuous_inv_fun := (isometry_inv_fun h).continuous,
  .. h.to_equiv }

lemma coe_eq_to_homeomorph (h : α ≃ᵢ β) (a : α) :
  h a = h.to_homeomorph a := rfl

lemma to_homeomorph_to_equiv (h : α ≃ᵢ β) :
  h.to_homeomorph.to_equiv = h.to_equiv :=
by ext; refl

protected def refl (α : Type*) [emetric_space α] : α ≃ᵢ α :=
{ isometry_to_fun := isometry_id, isometry_inv_fun := isometry_id, .. equiv.refl α }

protected def trans (h₁ : α ≃ᵢ β) (h₂ : β ≃ᵢ γ) : α ≃ᵢ γ :=
{ isometry_to_fun  := h₁.isometry_to_fun.comp h₂.isometry_to_fun,
  isometry_inv_fun := h₂.isometry_inv_fun.comp h₁.isometry_inv_fun,
  .. equiv.trans h₁.to_equiv h₂.to_equiv }

protected def symm (h : α ≃ᵢ β) : β ≃ᵢ α :=
{ isometry_to_fun  := h.isometry_inv_fun,
  isometry_inv_fun := h.isometry_to_fun,
  .. h.to_equiv.symm }

protected lemma isometry (h : α ≃ᵢ β) : isometry h := h.isometry_to_fun

lemma symm_comp_self (h : α ≃ᵢ β) : ⇑h.symm ∘ ⇑h = id :=
funext $ assume a, h.to_equiv.left_inv a

lemma self_comp_symm (h : α ≃ᵢ β) : ⇑h ∘ ⇑h.symm = id :=
funext $ assume a, h.to_equiv.right_inv a

lemma range_coe (h : α ≃ᵢ β) : range h = univ :=
eq_univ_of_forall $ assume b, ⟨h.symm b, congr_fun h.self_comp_symm b⟩

lemma image_symm (h : α ≃ᵢ β) : image h.symm = preimage h :=
image_eq_preimage_of_inverse h.symm.to_equiv.left_inv h.symm.to_equiv.right_inv

lemma preimage_symm (h : α ≃ᵢ β) : preimage h.symm = image h :=
(image_eq_preimage_of_inverse h.to_equiv.left_inv h.to_equiv.right_inv).symm

end isometric

/-- An isometry induces an isometric isomorphism between the source space and the
range of the isometry. -/
lemma isometry.isometric_on_range [emetric_space α] [emetric_space β] {f : α → β} (h : isometry f) :
  α ≃ᵢ range f :=
{ isometry_to_fun := λx y,
  begin
    change edist ((equiv.set.range f _) x) ((equiv.set.range f _) y) = edist x y,
    rw [equiv.set.range_apply f h.injective, equiv.set.range_apply f h.injective],
    exact h x y
  end,
  isometry_inv_fun :=
  begin
    apply isometry.inv,
    assume x y,
    change edist ((equiv.set.range f _) x) ((equiv.set.range f _) y) = edist x y,
    rw [equiv.set.range_apply f h.injective, equiv.set.range_apply f h.injective],
    exact h x y
  end,
  .. equiv.set.range f h.injective }

lemma isometry.isometric_on_range_apply [emetric_space α] [emetric_space β]
  {f : α → β} (h : isometry f) (x : α) : h.isometric_on_range x = ⟨f x, mem_range_self _⟩ :=
begin
  dunfold isometry.isometric_on_range,
  rw ← equiv.set.range_apply f h.injective x,
  refl
end


/-
Copyright (c) 2022 Junyan Xu. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Junyan Xu
-/
import data.dfinsupp.well_founded
import data.finsupp.lex

/-!
# Well-foundedness of the lexicographic and product orders on `finsupp`

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

`finsupp.lex.well_founded` and the two variants that follow it essentially say that if
`(>)` is a well order on `α`, `(<)` is well-founded on `N`, and `0` is a bottom element in `N`,
then the lexicographic `(<)` is well-founded on `α →₀ N`.

`finsupp.lex.well_founded_lt_of_finite` says that if `α` is finite and equipped with a linear
order and `(<)` is well-founded on `N`, then the lexicographic `(<)` is well-founded on `α →₀ N`.

`finsupp.well_founded_lt` and `well_founded_lt_of_finite` state the same results for the product
order `(<)`, but without the ordering conditions on `α`.

All results are transferred from `dfinsupp` via `finsupp.to_dfinsupp`.
-/

variables {α N : Type*}

namespace finsupp

variables [hz : has_zero N] {r : α → α → Prop} {s : N → N → Prop}
  (hbot : ∀ ⦃n⦄, ¬ s n 0) (hs : well_founded s)
include hbot hs

/-- Transferred from `dfinsupp.lex.acc`. See the top of that file for an explanation for the
  appearance of the relation `rᶜ ⊓ (≠)`. -/
lemma lex.acc (x : α →₀ N) (h : ∀ a ∈ x.support, acc (rᶜ ⊓ (≠)) a) : acc (finsupp.lex r s) x :=
begin
  rw lex_eq_inv_image_dfinsupp_lex, classical,
  refine inv_image.accessible to_dfinsupp (dfinsupp.lex.acc (λ a, hbot) (λ a, hs) _ _),
  simpa only [to_dfinsupp_support] using h,
end

theorem lex.well_founded (hr : well_founded $ rᶜ ⊓ (≠)) : well_founded (finsupp.lex r s) :=
⟨λ x, lex.acc hbot hs x $ λ a _, hr.apply a⟩

theorem lex.well_founded' [is_trichotomous α r]
  (hr : well_founded r.swap) : well_founded (finsupp.lex r s) :=
(lex_eq_inv_image_dfinsupp_lex r s).symm ▸
  inv_image.wf _ (dfinsupp.lex.well_founded' (λ a, hbot) (λ a, hs) hr)

omit hbot hs

instance lex.well_founded_lt [has_lt α] [is_trichotomous α (<)] [hα : well_founded_gt α]
  [canonically_ordered_add_monoid N] [hN : well_founded_lt N] : well_founded_lt (lex (α →₀ N)) :=
⟨lex.well_founded' (λ n, (zero_le n).not_lt) hN.wf hα.wf⟩

variable (r)

theorem lex.well_founded_of_finite [is_strict_total_order α r] [finite α] [has_zero N]
  (hs : well_founded s) : well_founded (finsupp.lex r s) :=
inv_image.wf (@equiv_fun_on_finite α N _ _) (pi.lex.well_founded r $ λ a, hs)

theorem lex.well_founded_lt_of_finite [linear_order α] [finite α] [has_zero N] [has_lt N]
  [hwf : well_founded_lt N] : well_founded_lt (lex (α →₀ N)) :=
⟨finsupp.lex.well_founded_of_finite (<) hwf.1⟩

protected theorem well_founded_lt [has_zero N] [preorder N] [well_founded_lt N]
  (hbot : ∀ n : N, ¬ n < 0) : well_founded_lt (α →₀ N) :=
⟨inv_image.wf to_dfinsupp (dfinsupp.well_founded_lt $ λ i a, hbot a).wf⟩

instance well_founded_lt' [canonically_ordered_add_monoid N]
  [well_founded_lt N] : well_founded_lt (α →₀ N) :=
finsupp.well_founded_lt $ λ a, (zero_le a).not_lt

instance well_founded_lt_of_finite [finite α] [has_zero N] [preorder N]
  [well_founded_lt N] : well_founded_lt (α →₀ N) :=
⟨inv_image.wf equiv_fun_on_finite function.well_founded_lt.wf⟩

end finsupp


/-
Copyright (c) 2016 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Johannes Hölzl

Galois connections - order theoretic adjoints.
-/
import standard
open classical eq.ops algebra set function complete_lattice

/- Move to set? -/
definition kern_image {X Y : Type} (f : X → Y) (S : set X) : set Y := {y | ∀x, f x = y → x ∈ S }

/- Order theoretic definitions -/

/- TODO: move to order? -/
section order
variables {A B : Type} {S : set A} {a a' : A} {b b' : B} {f : A → B} [weak_order A] [weak_order B]

definition increasing (f : A → A) := ∀⦃a⦄, a ≤ f a
definition decreasing (f : A → A) := ∀⦃a⦄, f a ≤ a

definition upper_bounds (S : set A) : set A := { x | ∀₀ s ∈ S, s ≤ x }
definition lower_bounds (S : set A) : set A := { x | ∀₀ s ∈ S, x ≤ s }
definition is_least (S : set A) (a : A) := a ∈ S ∧ a ∈ lower_bounds S
definition is_greatest (S : set A) (a : A) := a ∈ S ∧ a ∈ upper_bounds S

definition monotone (f : A → B) := ∀⦃a b⦄, a ≤ b → f a ≤ f b

lemma eq_of_is_least_of_is_least (Ha : is_least S a) (Hb : is_least S a') : a = a' :=
le.antisymm
  begin apply (and.elim_right Ha), apply (and.elim_left Hb) end
  begin apply (and.elim_right Hb), apply (and.elim_left Ha) end

lemma is_least_iff_eq_of_is_least (Ha : is_least S a) : is_least S a' ↔ a = a' :=
iff.intro (eq_of_is_least_of_is_least Ha) begin intro H, cases H, apply Ha end

lemma eq_of_is_greatest_of_is_greatest (Ha : is_greatest S a) (Hb : is_greatest S a') : a = a' :=
le.antisymm
  begin apply (and.elim_right Hb), apply (and.elim_left Ha) end
  begin apply (and.elim_right Ha), apply (and.elim_left Hb) end

lemma is_greatest_iff_eq_of_is_greatest (Ha : is_greatest S a) : is_greatest S a' ↔ a = a' :=
iff.intro (eq_of_is_greatest_of_is_greatest Ha) begin intro H, cases H, apply Ha end

definition is_lub (S : set A) := is_least (upper_bounds S)
definition is_glb (S : set A) := is_greatest (lower_bounds S)

lemma eq_of_is_lub_of_is_lub : is_lub S a → is_lub S a' → a = a' :=
!eq_of_is_least_of_is_least

lemma is_lub_iff_eq_of_is_lub : is_lub S a → (is_lub S a' ↔ a = a') :=
!is_least_iff_eq_of_is_least

lemma eq_of_is_glb_of_is_glb : is_glb S a → is_glb S a' → a = a' :=
!eq_of_is_greatest_of_is_greatest

lemma is_glb_iff_eq_of_is_glb : is_glb S a → (is_glb S a' ↔ a = a') :=
!is_greatest_iff_eq_of_is_greatest

lemma mem_upper_bounds_image (Hf : monotone f) (Ha : a ∈ upper_bounds S) : f a ∈ upper_bounds (f ' S) :=
bounded_forall_image_of_bounded_forall (take x H, Hf (Ha `x ∈ S`))

lemma mem_lower_bounds_image (Hf : monotone f) (Ha : a ∈ lower_bounds S) : f a ∈ lower_bounds (f ' S) :=
bounded_forall_image_of_bounded_forall (take x H, Hf (Ha `x ∈ S`))

end order

definition galois_connection {A B : Type} [weak_order A] [weak_order B] (l : A → B) (u : B → A) :=
  ∀{a b}, l a ≤ b ↔ a ≤ u b

namespace galois_connection

section
parameters {A B : Type} [weak_order A] [weak_order B] (l : A → B) (u : B → A)

lemma monotone_intro (Mu : monotone u) (Ml : monotone l)
    (Iul : increasing (u ∘ l)) (Dlu : decreasing (l ∘ u)) : galois_connection l u :=
begin
  intros a b,
  apply iff.intro,
  { intro H, apply le.trans, apply Iul, apply Mu, assumption },
  { intro H, apply le.trans, apply Ml, assumption, apply Dlu }
end

parameter (gc : galois_connection l u)
include gc

lemma l_le {a : A} {b : B} : a ≤ u b → l a ≤ b :=
and.elim_right !gc

lemma le_u {a : A} {b : B} : l a ≤ b → a ≤ u b :=
and.elim_left !gc

lemma increasing_u_l : increasing (u ∘ l) :=
take a, le_u !le.refl

lemma decreasing_l_u : decreasing (l ∘ u) :=
take a, l_le !le.refl

lemma monotone_u : monotone u :=
take a b H, le_u (le.trans !decreasing_l_u H)

lemma monotone_l : monotone l :=
take a b H, l_le (le.trans H !increasing_u_l)

lemma u_l_u_eq_u : u ∘ l ∘ u = u :=
funext (take x, le.antisymm (monotone_u !decreasing_l_u) !increasing_u_l)

lemma l_u_l_eq_l : l ∘ u ∘ l = l :=
funext (take x, le.antisymm !decreasing_l_u (monotone_l !increasing_u_l))

lemma u_mem_upper_bounds {S : set A} {b : B} (H : b ∈ upper_bounds (l ' S)) : u b ∈ upper_bounds S :=
take c, suppose c ∈ S, le_u (H (!mem_image_of_mem `c ∈ S`))

lemma l_mem_lower_bounds {S : set B} {a : A} (H : a ∈ lower_bounds (u ' S)) : l a ∈ lower_bounds S :=
take c, suppose c ∈ S, l_le (H (!mem_image_of_mem `c ∈ S`))

lemma is_lub_l_image {S : set A} {a : A} (H : is_lub S a) : is_lub (l ' S) (l a) :=
and.intro
  (mem_upper_bounds_image monotone_l (and.elim_left `is_lub S a`))
  (take b Hb, l_le (and.elim_right `is_lub S a` _ (u_mem_upper_bounds Hb)))

lemma is_glb_u_image {S : set B} {b : B} (H : is_glb S b) : is_glb (u ' S) (u b) :=
and.intro
  (mem_lower_bounds_image monotone_u (and.elim_left `is_glb S b`))
  (take a Ha, le_u (and.elim_right `is_glb S b` _ (l_mem_lower_bounds Ha)))

lemma is_glb_l {a : A} : is_glb { b | a ≤ u b } (l a) :=
begin
  apply and.intro,
  { intro b, apply l_le },
  { intro b H, apply H, apply increasing_u_l }
end

lemma is_lub_u {b : B} : is_lub { a | l a ≤ b } (u b) :=
begin
  apply and.intro,
  { intro a, apply le_u },
  { intro a H, apply H, apply decreasing_l_u }
end

end

/- Constructing Galois connections -/

protected lemma id {A : Type} [weak_order A] : @galois_connection A A _ _ id id :=
take a b, iff.intro (λx, x) (λx, x)

protected lemma dual {A B : Type} [woA : weak_order A] [woB : weak_order B]
  (l : A → B) (u : B → A) (gc : galois_connection l u) :
  @galois_connection B A (weak_order_dual woB) (weak_order_dual woA) u l :=
take a b,
begin
  apply iff.symm,
  rewrite le_dual_eq_le,
  rewrite le_dual_eq_le,
  exact gc,
end

protected lemma compose {A B C : Type} [weak_order A] [weak_order B] [weak_order C]
  (l1 : A → B) (u1 : B → A) (l2 : B → C) (u2 : C → B)
  (gc1 : galois_connection l1 u1) (gc2 : galois_connection l2 u2) :
  galois_connection (l2 ∘ l1) (u1 ∘ u2) :=
by intros; rewrite gc2; rewrite gc1

section
  variables {A B : Type} {f : A → B}

  protected lemma image_preimage : galois_connection (image f) (preimage f) :=
    @image_subset_iff A B f

  protected lemma preimage_kern_image : galois_connection (preimage f) (kern_image f) :=
  begin
    intros X Y, apply iff.intro, all_goals (intro H x Hx),
    { intro x' eq, apply H, cases eq, exact Hx },
    { apply H,
      esimp [preimage, mem, set_of] at Hx, exact Hx, -- TODO: why is esimp necessary?
      exact rfl }
  end
end

end galois_connection

/- Bounds on complete lattices -/
/- TODO: move to complete lattices? -/

section
variables {A : Type} (S : set A) {a b : A} [complete_lattice A]

lemma is_lub_sup : is_lub '{a, b} (sup a b) :=
and.intro
  begin
    xrewrite [+bounded_forall_insert_iff, bounded_forall_empty_iff, and_true],
    exact (and.intro !le_sup_left !le_sup_right)
  end
  begin
    intro x Hx,
    xrewrite [+bounded_forall_insert_iff at Hx, bounded_forall_empty_iff at Hx, and_true at Hx],
    apply sup_le,
    apply (and.elim_left Hx),
    apply (and.elim_right Hx),
  end

lemma is_lub_Sup : is_lub S (⨆S) :=
and.intro (take x, le_Sup) (take x, Sup_le)

lemma is_lub_iff_Sup_eq {a : A} : is_lub S a ↔ (⨆S) = a :=
!is_lub_iff_eq_of_is_lub !is_lub_Sup

lemma is_glb_Inf : is_glb S (⨅S) :=
and.intro (take a, Inf_le) (take a, le_Inf)

lemma is_glb_iff_Inf_eq : is_glb S a ↔ (⨅S) = a :=
!is_glb_iff_eq_of_is_glb !is_glb_Inf

end


/-
Copyright (c) 2020 Frédéric Dupuis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Frédéric Dupuis
-/
import analysis.convex.function
import topology.algebra.affine
import topology.local_extr
import topology.metric_space.basic

/-!
# Minima and maxima of convex functions

We show that if a function `f : E → β` is convex, then a local minimum is also
a global minimum, and likewise for concave functions.
-/

variables {E β : Type*} [add_comm_group E] [topological_space E]
  [module ℝ E] [topological_add_group E] [has_continuous_smul ℝ E]
  [ordered_add_comm_group β] [module ℝ β] [ordered_smul ℝ β]
  {s : set E}

open set filter function
open_locale classical topological_space

/--
Helper lemma for the more general case: `is_min_on.of_is_local_min_on_of_convex_on`.
-/
lemma is_min_on.of_is_local_min_on_of_convex_on_Icc {f : ℝ → β} {a b : ℝ} (a_lt_b : a < b)
  (h_local_min : is_local_min_on f (Icc a b) a) (h_conv : convex_on ℝ (Icc a b) f) :
  is_min_on f (Icc a b) a :=
begin
  rintro c hc, dsimp only [mem_set_of_eq],
  rw [is_local_min_on, nhds_within_Icc_eq_nhds_within_Ici a_lt_b] at h_local_min,
  rcases hc.1.eq_or_lt with rfl|a_lt_c, { exact le_rfl },
  have H₁ : ∀ᶠ y in 𝓝[>] a, f a ≤ f y,
    from h_local_min.filter_mono (nhds_within_mono _ Ioi_subset_Ici_self),
  have H₂ : ∀ᶠ y in 𝓝[>] a, y ∈ Ioc a c,
    from Ioc_mem_nhds_within_Ioi (left_mem_Ico.2 a_lt_c),
  rcases (H₁.and H₂).exists with ⟨y, hfy, hy_ac⟩,
  rcases (convex.mem_Ioc a_lt_c).mp hy_ac with ⟨ya, yc, ya₀, yc₀, yac, rfl⟩,
  suffices : ya • f a + yc • f a ≤ ya • f a + yc • f c,
    from (smul_le_smul_iff_of_pos yc₀).1 (le_of_add_le_add_left this),
  calc ya • f a + yc • f a = f a : by rw [← add_smul, yac, one_smul]
  ... ≤ f (ya * a + yc * c)      : hfy
  ... ≤ ya • f a + yc • f c      : h_conv.2 (left_mem_Icc.2 a_lt_b.le) hc ya₀ yc₀.le yac
end

/--
A local minimum of a convex function is a global minimum, restricted to a set `s`.
-/
lemma is_min_on.of_is_local_min_on_of_convex_on {f : E → β} {a : E}
  (a_in_s : a ∈ s) (h_localmin : is_local_min_on f s a) (h_conv : convex_on ℝ s f) :
  is_min_on f s a :=
begin
  intros x x_in_s,
  let g : ℝ →ᵃ[ℝ] E := affine_map.line_map a x,
  have hg0 : g 0 = a := affine_map.line_map_apply_zero a x,
  have hg1 : g 1 = x := affine_map.line_map_apply_one a x,
  have hgc : continuous g, from affine_map.line_map_continuous,
  have h_maps : maps_to g (Icc 0 1) s,
  { simpa only [maps_to', ← segment_eq_image_line_map]
      using h_conv.1.segment_subset a_in_s x_in_s },
  have fg_local_min_on : is_local_min_on (f ∘ g) (Icc 0 1) 0,
  { rw ← hg0 at h_localmin,
    exact h_localmin.comp_continuous_on h_maps hgc.continuous_on (left_mem_Icc.2 zero_le_one) },
  have fg_min_on : is_min_on (f ∘ g) (Icc 0 1 : set ℝ) 0,
  { refine is_min_on.of_is_local_min_on_of_convex_on_Icc one_pos fg_local_min_on _,
    exact (h_conv.comp_affine_map g).subset h_maps (convex_Icc 0 1) },
  simpa only [hg0, hg1, comp_app, mem_set_of_eq] using fg_min_on (right_mem_Icc.2 zero_le_one)
end

/-- A local maximum of a concave function is a global maximum, restricted to a set `s`. -/
lemma is_max_on.of_is_local_max_on_of_concave_on {f : E → β} {a : E}
  (a_in_s : a ∈ s) (h_localmax: is_local_max_on f s a) (h_conc : concave_on ℝ s f) :
  is_max_on f s a :=
@is_min_on.of_is_local_min_on_of_convex_on _ βᵒᵈ _ _ _ _ _ _ _ _ s f a a_in_s h_localmax h_conc

/-- A local minimum of a convex function is a global minimum. -/
lemma is_min_on.of_is_local_min_of_convex_univ {f : E → β} {a : E}
  (h_local_min : is_local_min f a) (h_conv : convex_on ℝ univ f) : ∀ x, f a ≤ f x :=
λ x, (is_min_on.of_is_local_min_on_of_convex_on (mem_univ a)
        (h_local_min.on univ) h_conv) (mem_univ x)

/-- A local maximum of a concave function is a global maximum. -/
lemma is_max_on.of_is_local_max_of_convex_univ {f : E → β} {a : E}
  (h_local_max : is_local_max f a) (h_conc : concave_on ℝ univ f) : ∀ x, f x ≤ f a :=
@is_min_on.of_is_local_min_of_convex_univ _ βᵒᵈ _ _ _ _ _ _ _ _ f a h_local_max h_conc


/-
Copyright (c) 2019 Patrick Massot All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Patrick Massot, Simon Hudon

A tactic pushing negations into an expression
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.logic.basic
import Mathlib.algebra.order
import Mathlib.PostPort

universes u

namespace Mathlib

namespace push_neg

theorem not_not_eq (p : Prop) : (¬¬p) = p := propext not_not

theorem not_and_eq (p : Prop) (q : Prop) : (¬(p ∧ q)) = (p → ¬q) := propext not_and

theorem not_or_eq (p : Prop) (q : Prop) : (¬(p ∨ q)) = (¬p ∧ ¬q) := propext not_or_distrib

theorem not_forall_eq {α : Sort u} (s : α → Prop) : (¬∀ (x : α), s x) = ∃ (x : α), ¬s x :=
  propext not_forall

theorem not_exists_eq {α : Sort u} (s : α → Prop) : (¬∃ (x : α), s x) = ∀ (x : α), ¬s x :=
  propext not_exists

theorem not_implies_eq (p : Prop) (q : Prop) : (¬(p → q)) = (p ∧ ¬q) := propext not_imp

theorem classical.implies_iff_not_or (p : Prop) (q : Prop) : p → q ↔ ¬p ∨ q := imp_iff_not_or

theorem not_eq {α : Sort u} (a : α) (b : α) : ¬a = b ↔ a ≠ b := iff.rfl

theorem not_le_eq {β : Type u} [linear_order β] (a : β) (b : β) : (¬a ≤ b) = (b < a) :=
  propext not_le

theorem not_lt_eq {β : Type u} [linear_order β] (a : β) (b : β) : (¬a < b) = (b ≤ a) :=
  propext not_lt

end push_neg

/--
Push negations in the goal of some assumption.

For instance, a hypothesis `h : ¬ ∀ x, ∃ y, x ≤ y` will be transformed by `push_neg at h` into
`h : ∃ x, ∀ y, y < x`. Variables names are conserved.

This tactic pushes negations inside expressions. For instance, given an assumption
```lean
h : ¬ ∀ ε > 0, ∃ δ > 0, ∀ x, |x - x₀| ≤ δ → |f x - y₀| ≤ ε)
```
writing `push_neg at h` will turn `h` into
```lean
h : ∃ ε, ε > 0 ∧ ∀ δ, δ > 0 → (∃ x, |x - x₀| ≤ δ ∧ ε < |f x - y₀|),
```

(the pretty printer does *not* use the abreviations `∀ δ > 0` and `∃ ε > 0` but this issue
has nothing to do with `push_neg`).
Note that names are conserved by this tactic, contrary to what would happen with `simp`
using the relevant lemmas. One can also use this tactic at the goal using `push_neg`,
at every assumption and the goal using `push_neg at *` or at selected assumptions and the goal
using say `push_neg at h h' ⊢` as usual.
-/
theorem imp_of_not_imp_not (P : Prop) (Q : Prop) : (¬Q → ¬P) → P → Q :=
  fun (h : ¬Q → ¬P) (hP : P) => classical.by_contradiction fun (h' : ¬Q) => h h' hP

/-- Matches either an identifier "h" or a pair of identifiers "h with k" -/
/--
Transforms the goal into its contrapositive.

* `contrapose`     turns a goal `P → Q` into `¬ Q → ¬ P`
* `contrapose!`    turns a goal `P → Q` into `¬ Q → ¬ P` and pushes negations inside `P` and `Q`
  using `push_neg`
* `contrapose h`   first reverts the local assumption `h`, and then uses `contrapose` and `intro h`
* `contrapose! h`  first reverts the local assumption `h`, and then uses `contrapose!` and `intro h`
* `contrapose h with new_h` uses the name `new_h` for the introduced hypothesis
-/
end Mathlib


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

import tactic

/-

# Basic Number Theory

Lean has enough machinery to make number theory a feasible topic for
a final project. In this section I will work through a bunch of examples,
taken from Sierpinski's old book "250 elementary problems in number theory".

## Switching between naturals and integers

Sometimes when doing number theory in Lean you find yourself having to switch
between naturals, integers and rationals. For example, if you want to do `a ^ n`
with `a` an integer, then `n` had better be a natural number, because in general
you can't raise an integer to the power of an integer. However subtraction is
"broken" on naturals:

-/

example : (2 : ℕ) - 3 = 0 := rfl -- subtraction on naturals "rounds up to 0" as it must return a natural

example : (2 : ℤ) - 3 = -1 := rfl -- subtraction on integers works correctly

/-

so sometimes you need to dance between the two. There are coercions between
all of these objects:

-/

example (n : ℕ) : ℤ := n -- works fine
example (n : ℕ) : ℤ := ↑n -- what it does under the hood
example (n : ℕ) (z : ℤ) : ℚ := n + z -- gets translated to ↑n + ↑z where the two ↑s
                                     -- represent different functions (ℕ → ℚ and ℤ → ℚ)

/-

The big problem with this is that you end up with goals and hypotheses with `↑` in
which you want to "cancel". The `norm_cast` tactic does this.

-/

example (a b : ℕ) (h : a + b = 37) : (a : ℤ) + b = 37 :=
begin
  /-
  a b : ℕ
  h : a + b = 37
  ⊢ ↑a + ↑b = 37

  exact `h` fails, because of the coercions (the goal is about the integer 37,
  not the natural 37)
  -/

  norm_cast, -- goal now becomes `a + b = 37`
  exact h,
end

-- There are several shortcuts you can take here, for example
example (a b : ℕ) (h : a + b = 37) : (a : ℤ) + b = 37 :=
begin
  exact_mod_cast h, -- `h` is "correct modulo coercions"
end

example (a b : ℕ) (h : a + b = 37) : (a : ℤ) + b = 37 :=
begin
  assumption_mod_cast, -- "it's an assumption, modulo coercions"
end

-- The `ring` tactic can't deal with the `↑`s here (it's not its job)
example (a b : ℕ) : ((a + b : ℕ) : ℤ)^2=a^2+2*a*b+b^2 :=
begin
  norm_cast, -- all the ↑s are gone now
  ring,
end

-- Another approach:
example (a b : ℕ) : ((a + b : ℕ) : ℤ)^2=a^2+2*a*b+b^2 :=
begin
  push_cast, -- does the "opposite" to `norm_cast`. The `norm_cast` tactic
             -- tries to pull `↑`s out as much as possible (so it changes `↑a + ↑b`
             -- to `↑(a + b)`), and then tries to cancel them. `push_cast` pushes
             -- the ↑s "inwards", i.e. as tightly up to the variables as it can.

             -- Goal is now
             -- ⊢ (↑a + ↑b) ^ 2 = ↑a ^ 2 + 2 * ↑a * ↑b + ↑b ^ 2
  ring,      -- works fine, with variables ↑a and ↑b.
end

/-

These `cast` tactics do not quite solve all your problems, however.
Sometimes you have statements about naturals, and you would rather
they were about integers (for example because you want to start
using subtraction). You can use the `zify` tactic to change statements
about naturals to statements about integers, and the `lift` tactic to
change statements about integers to statements about naturals. Check
out the Lean 3 documentation for these tactics if you want to know
more (I didn't cover them in the course notes):

https://leanprover-community.github.io/mathlib_docs/tactic/zify.html#tactic.interactive.zify
https://leanprover-community.github.io/mathlib_docs/tactic/lift.html#tactic.interactive.lift

## For which positive integers n does n+1 divide n^2+1?

This is the first question in Sierpinski's book.

Hint: n+1 divides n^2-1.

-/

example (n : ℕ) (hn : 0 < n) : (n + 1) ∣ (n^2 + 1) ↔ n = 1 :=
begin
  sorry,
end


-- Chapter 3

variables p q r s: Prop

-- #check p → q → p ∧ q
-- #check ¬p → p ↔ false
-- #check p ∨ q → q ∧ p

-- commutativity of ∧ and ∨
theorem and_comm_ : p ∧ q ↔ q ∧ p :=
iff.intro
  (assume hpq : p ∧ q,
    show q ∧ p, from ⟨(and.right hpq), (and.left hpq)⟩)
  (assume hqp : q ∧ p,
    show p ∧ q, from ⟨(and.right hqp), (and.left hqp)⟩)

theorem or_comm_ : p ∨ q ↔ q ∨ p :=
iff.intro
  (assume hpq: p ∨ q,
    hpq.elim
      (assume hp:p, or.inr hp)
      (assume hq:q, or.inl hq))
  (assume hqp: q ∨ p,
    hqp.elim
      (assume hq:q, or.inr hq)
      (assume hp:p, or.inl hp))

-- associativity of ∧ and ∨
theorem and_assoc_ : (p ∧ q) ∧ r ↔ p ∧ (q ∧ r) :=
iff.intro
  (assume h : (p ∧ q) ∧ r,
    show p ∧ (q ∧ r), from ⟨h.left.left, ⟨h.left.right, h.right⟩⟩)
  (assume h : p ∧ (q ∧ r),
      show (p ∧ q) ∧ r, from ⟨⟨h.left, h.right.left⟩,h.right.right⟩)

theorem or_assoc_ : (p ∨ q) ∨ r ↔ p ∨ (q ∨ r) :=
iff.intro
  (assume h: (p ∨ q) ∨ r,
    or.elim h
      (assume hpq : p ∨ q,
        show p ∨ (q ∨ r),
        from hpq.elim
          (assume hp : p, or.inl hp)
          (assume hq : q, or.inr (or.inl hq)))
      (assume hr : r,
        show p ∨ (q ∨ r),
        from or.inr (or.inr hr)))
  (assume h: p ∨ (q ∨ r),
    or.elim h
    (assume hp : p,
      show (p ∨ q) ∨ r,
      from or.inl (or.inl hp))
    (assume hqr : q ∨ r,
      or.elim hqr
      (assume hq : q,
        show (p ∨ q) ∨ r,
        from or.inl (or.inr hq))
      (assume hr : r,
        show (p ∨ q) ∨ r,
        from or.inr hr)))

-- distributivity
theorem and_to_or_dist : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) :=
iff.intro
  (assume h : p ∧ (q ∨ r),
    show (p ∧ q) ∨ (p ∧ r),
    from or.elim h.right
      (assume hq : q, or.inl ⟨h.left,hq⟩)
      (assume hr : r, or.inr ⟨h.left,hr⟩))
  (assume h :(p ∧ q) ∨ (p ∧ r),
      show p ∧ (q ∨ r),
      from or.elim h
        (assume hpq : p ∧ q, and.intro hpq.left (or.inl hpq.right))
        (assume hpr : p ∧ r, and.intro hpr.left (or.inr hpr.right)))

theorem or_to_and_dist : p ∨ (q ∧ r) ↔ (p ∨ q) ∧ (p ∨ r) :=
iff.intro
  (assume h : p ∨ (q ∧ r),
    show (p ∨ q) ∧ (p ∨ r),
    from h.elim
      (assume hp : p, and.intro (or.inl hp) (or.inl hp))
      (assume hqr : q ∧ r, and.intro (or.inr hqr.left) (or.inr hqr.right)))
  (assume h : (p ∨ q) ∧ (p ∨ r),
    show p ∨ (q ∧ r), from
    have hpq : p ∨ q, from h.left,
    have hpr : p ∨ r, from h.right,
    hpq.elim
      (assume hp : p, or.inl hp)
      (assume hq : q,
        hpr.elim
          (assume hp : p, or.inl hp)
          (assume hr : r, or.inr ⟨hq, hr⟩)))

-- other properties
-- exportation name comes from book 'Modern Formal Logic', McKay
theorem exportation : (p → (q → r)) ↔ (p ∧ q → r) :=
iff.intro
  (assume h : p → (q → r),
    assume hpq : p ∧ q,
      h hpq.left hpq.right)
  (assume h : p ∧ q → r,
    assume hp : p,
      assume hq : q,
        h ⟨hp, hq⟩)

-- resorting to numbering, who knows what these should be called
theorem t1 : ((p ∨ q) → r) ↔ (p → r) ∧ (q → r) :=
iff.intro
  (assume h : (p ∨ q) → r,
    show (p → r) ∧ (q → r),
    from and.intro
      (assume hp : p,
        h (or.inl hp))
      (assume hq : q,
        h (or.inr hq)))
  (assume h : (p → r) ∧ (q → r),
    show (p ∨ q) → r,
    from assume hpq : p ∨ q,
      hpq.elim
        (assume hp : p,
          have hr : r, from h.left hp, hr)
        (assume hq : q,
          have hr : r, from h.right hq, hr))

-- DeMorgan's laws
theorem dem1 : ¬(p ∨ q) ↔ ¬p ∧ ¬q :=
iff.intro
  (assume h : ¬(p ∨ q),
    show ¬p ∧ ¬q,
    from and.intro
      (show ¬p, from assume hp : p, absurd (or.inl hp) h)
      (show ¬q, from assume hq : q, absurd (or.inr hq) h))
  (assume h : ¬p ∧ ¬q,
    show ¬(p ∨ q),
    from assume hpq : p ∨ q,
    show false, from hpq.elim
        (assume hp : p, absurd hp h.left)
        (assume hq : q, absurd hq h.right))

theorem dem2 : ¬p ∨ ¬q → ¬(p ∧ q) :=
assume h : ¬p ∨ ¬q,
  assume hpq : p ∧ q, h.elim
    (assume hnp : ¬p, absurd hpq.left hnp)
    (assume hnq : ¬q, absurd hpq.right hnq)

theorem paradox : ¬(p ∧ ¬p) :=
assume h : p ∧ ¬p, absurd h.left h.right

theorem t2: p ∧ ¬q → ¬(p → q) :=
assume h : p ∧ ¬q,
  assume hptq : p → q,
  have hq : q, from hptq h.left,
  show false, from absurd hq h.right

theorem t3 : ¬p → (p → q) :=
assume h : ¬p,
  assume hp : p,
    false.elim (h hp)

theorem t4 : (¬p ∨ q) → (p → q) :=
assume h : ¬p ∨ q,
  assume hp : p, h.elim
    (assume hnp : ¬p, absurd hp hnp)
    (assume hq : q, hq)

theorem t5 : p ∨ false ↔ p :=
iff.intro
  (assume h : p ∨ false,
    h.elim (λ hp, hp) (λ false, false.elim))
  (assume p,
    or.inl p)

theorem t6 : p ∧ false ↔ false :=
iff.intro
  (assume h : p ∧ false, h.right)
  (assume false, false.elim)

theorem t7 : ¬(p ↔ ¬p) :=
assume h : p ↔ ¬p,
  have hnp : p → false, from
    assume hp : p, have hnp : ¬p, from h.mp hp, absurd hp hnp,
  absurd (h.mpr hnp) hnp

-- helper function, modus tollens
theorem modus_tollens : (p → q) → ¬q → ¬p :=
assume h : p → q,
  assume hnq : ¬q,
    assume hp : p, absurd (h hp) hnq

theorem t8 : (p → q) → (¬q → ¬p) :=
assume h : p → q,
  assume hnq : ¬q, (modus_tollens p q) h hnq

-- classical section:
open classical

-- variables p q r s : Prop

theorem c1 : (p → r ∨ s) → ((p → r) ∨ (p → s)) :=
assume h : p → r ∨ s,
or.elim (em p)
  (assume hp : p,
  show ((p → r) ∨ (p → s)), from
    have hrs : r ∨ s, from h hp,
      hrs.elim
      (assume hr : r,
        suffices hpr : p → r,
        from or.inl hpr,
        assume hp : p, hr)
      (assume hs : s,
        suffices hps : p → s,
        from or.inr hps,
        assume hp: p, hs))
  (assume hnp : ¬p,
  show ((p → r) ∨ (p → s)), from
    suffices hpr : p → r, from or.inl hpr,
      assume hp : p, absurd hp hnp)

theorem c2 : ¬(p ∧ q) → ¬p ∨ ¬q :=
assume h : ¬(p ∧ q),
show ¬p ∨ ¬q, from
or.elim (em p)
  (assume hp : p,
    or.elim (em q)
    (assume hq : q,
      absurd (and.intro hp hq) h)
    (assume hnq : ¬q,
      or.inr hnq))
  (assume hnp : ¬p,
    or.inl hnp)

theorem c3 : ¬(p → q) → p ∧ ¬q :=
assume h : ¬(p → q),
show p ∧ ¬q, from
or.elim (em p)
  (assume hp : p,
    or.elim (em q)
      (assume hq : q,
        have hptq : p → q, from assume hp : p, hq,
        absurd hptq h)
      (assume hnq : ¬q,
        and.intro hp hnq))
  (assume hnp : ¬p,
    or.elim (em q)
      (assume hq : q,
        have hptq : p → q, from assume hp : p, hq,
        absurd hptq h)
      (assume hnq : ¬q,
        suffices hptq : p → q, from false.elim (h hptq),
        assume hp : p, absurd hp hnp))

theorem c4 : (p → q) → (¬p ∨ q) :=
assume h : p → q,
show (¬p ∨ q), from
or.elim (em p)
  (assume hp : p,
    or.elim (em q)
      (assume hq : q,
        or.inr hq)
      (assume hnq : ¬q,
        have hq : q, from h hp,
        absurd hq hnq))
  (assume hnp : ¬p,
    or.elim (em q)
      (assume hq : q,
        or.inr hq)
      (assume hnq : ¬q,
        or.inl hnp))

theorem c5 : (¬q → ¬p) → (p → q) :=
assume h : (¬q → ¬p),
show p → q, from
or.elim (em q)
  (assume hq : q,
    or.elim (em p)
      (assume hp : p,
        (assume hp : p, hq))
      (assume hnp : ¬p,
        (assume hp : p, hq)))
  (assume hnq : ¬q,
    or.elim (em p)
      (assume hp : p,
        have hnp : ¬p, from h hnq,
        absurd hp hnp)
      (assume hnp : ¬p,
        (assume hp : p,
        absurd hp hnp)))

theorem c6 : p ∨ ¬p :=
or.elim (em p)
  (assume hp : p,
    or.inl hp)
  (assume hnp : ¬p,
      or.inr hnp)

theorem c7 : (((p → q) → p) → p) :=
assume h : ((p → q) → p),
show p, from
or.elim (em p)
  (assume hp : p, hp)
  (assume hnp : ¬p,
    have hptq : p → q, from assume hp : p, absurd hp hnp,
  absurd (h hptq) hnp)


import field_theory.finite.basic

namespace int

variables {n a b : ℤ} {m : ℕ}

namespace modeq

theorem modeq_pow {m a b : ℤ} (h : a ≡ b [ZMOD m]) :
	∀ k : ℕ, a ^ k ≡ b ^ k [ZMOD m]
| 0     := rfl
| (n+1) := by rw [pow_succ, pow_succ]; apply modeq_mul h (modeq_pow n)

theorem pow_modeq_one {m a : ℤ} (ha : a ≡ 1 [ZMOD m]) (k : ℕ) :
	a ^ k ≡ 1 [ZMOD m] :=
by rw [← one_pow k]; apply modeq_pow ha

theorem is_coprime_of_modeq (hcop : is_coprime a n) (hmodeq : a ≡ b [ZMOD n]) :
  is_coprime b n :=
begin
  cases modeq_iff_dvd.mp hmodeq with x hx,
  rw [sub_eq_iff_eq_add, add_comm] at hx,
  rwa [hx, is_coprime.add_mul_left_left_iff],
end

local notation ` ϕ ` := nat.totient

lemma pow_totient {x : ℤ} {n : ℕ} (h : is_coprime x n) :
  x ^ ϕ n ≡ 1 [ZMOD n] :=
begin
  cases n, { rw [nat.totient_zero, pow_zero] },
  rcases @exists_unique_equiv_nat x ↑(n.succ) _ with ⟨y, hyn, hy⟩, swap,
  { rw coe_nat_pos, apply nat.succ_pos },
  apply modeq.trans (modeq_pow hy.symm _),
  rw [← coe_nat_pow, ← int.coe_nat_one, int.modeq.coe_nat_modeq_iff],
  apply nat.modeq.pow_totient,
  rw ← nat.is_coprime_iff_coprime,
  exact int.modeq.is_coprime_of_modeq h hy.symm,
end

end modeq

theorem is_coprime_of_prime_not_dvd {p : ℕ} (hp : p.prime) : is_coprime a p ↔ ¬ ↑p ∣ a :=
begin
  rw ← int.gcd_eq_one_iff_coprime,
  split,
  { intros hcop hdvd,
    have := int.dvd_gcd hdvd (dvd_refl _),
    rw hcop at this,
    have peq1 := eq_one_of_dvd_one (coe_nat_nonneg p) this,
    norm_cast at peq1,
    rw peq1 at hp,
    exact nat.not_prime_one hp },
  intro hndvd,
  cases (nat.dvd_prime hp).mp (coe_nat_dvd.mp $ gcd_dvd_right a p) with h1 heqp,
  { assumption },
  exfalso, apply hndvd, rw ← heqp, apply gcd_dvd_left,
end

end int


/-
Copyright (c) 2018 Rohan Mitta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Rohan Mitta
-/
import analysis.metric_space
import analysis.topology.topological_space
import order.filter
import tactic.norm_num

noncomputable theory
local attribute [instance] classical.prop_decidable

--Patrick's Lemmas
variables {α : Type*} {β : Type*}
open filter

lemma tendsto_nhds_iff [metric_space α] (u : β → α) (f : filter β) (a : α) : tendsto u f (nhds a) ↔
  ∀ ε > 0, ∃ s ∈ f.sets, ∀ {n}, n ∈ s → dist (u n) a < ε :=
⟨λ H ε εpos, ⟨u ⁻¹' ball a ε, ⟨H $ ball_mem_nhds a εpos, λ n h, h⟩⟩,
 λ H s s_nhd, let ⟨ε, εpos, sub⟩ := mem_nhds_iff_metric.1 s_nhd in
   let ⟨N, ⟨N_in, H'⟩⟩ := H ε εpos in f.sets_of_superset N_in (λ b b_in, sub $ H' b_in)⟩

lemma seq_tendsto_iff [metric_space α] (u : ℕ → α) (a : α) : tendsto u at_top (nhds a) ↔
  ∀ ε > 0, ∃ (N : ℕ), ∀ {n}, n ≥ N → dist (u n) a < ε :=
⟨λ H ε εpos, mem_at_top_sets.1 $ mem_map.2 $ H (ball_mem_nhds _ εpos),
 λ H s s_nhd, let ⟨ε, εpos, sub⟩ := mem_nhds_iff_metric.1 s_nhd in
   let ⟨N, H'⟩ := H ε εpos in mem_at_top_sets.2 ⟨N, λ n nN,
   sub $ mem_ball.2 $ H' nN⟩⟩

--Sutherland Exercise 6.26 (as setup for prop 17.6)

theorem lim_sequence_of_mem_closure {α : Type*} [metric_space α] {Y : set α} {a : α} (H : a ∈ closure Y) :
∃ (f : ℕ → α) (H1 : ∀ (n : ℕ), f n ∈ Y), filter.tendsto f at_top (nhds a)  :=
begin
  let ball_n := λ (n : ℕ), ball a ((1 : ℝ)/n),
  have H1 : ∀ (n : ℕ), nonempty {x : α | x ∈ (ball_n (n+1)) ∩ Y},
  { intro n,
    apply @nonempty_of_exists _ (λ _,true),
    have H3 := set.exists_mem_of_ne_empty ((mem_closure_iff_nhds.1 H) (ball_n (n+1)) (ball_mem_nhds _ _)),
    { cases H3 with xn Hxn,
      existsi (⟨xn, Hxn⟩ : ↥{x : α | x ∈ ball_n (n+1) ∩ Y}),
      trivial },
    apply div_pos, exact zero_lt_one, rw ← nat.cast_zero, apply nat.cast_lt.2,
    apply zero_lt_iff_ne_zero.2, apply nat.succ_ne_zero },

  have sequence := λ (n : ℕ), classical.choice (H1 n),
  let sequencevals := λ (n : ℕ), (sequence n).val,
  existsi sequencevals,

  have H1 : ∀ (n : ℕ), sequencevals n ∈ Y,
  { show ∀ (n : ℕ), (sequence n).val ∈ Y,
    let sequenceprops := λ (n : ℕ), ((sequence n).property).2,
    exact sequenceprops },
  existsi H1,
  rw tendsto_nhds_iff _ _ _,
  intros ep Hep,
  let nat_one_over_ep := int.nat_abs (ceil (1/ep)),
  existsi [{n : ℕ | nat_one_over_ep ≤ n}, _], swap,
  { rw filter.mem_at_top_sets,
    existsi nat_one_over_ep,
    exact λ b Hb, Hb },

  intros n Hn,
  show dist (sequence n).val a < ep,

  have : dist (sequence n).val a < (1 / ↑(n+1)) := (sequence n).property.1,
  apply lt.trans this,
  rw one_div_eq_inv,

  have H3: 0 < (↑(n + 1) : ℝ),
  { rw ← nat.cast_zero,
    rw (@nat.cast_lt ℝ _ 0 (n+1)),
    exact zero_lt_iff_ne_zero.2 (nat.succ_ne_zero n) },
  rw (@inv_lt ℝ _ ↑(n + 1) ep) H3 Hep,
  dsimp at Hn, rw ← one_div_eq_inv,
  have H4 := nat.lt_succ_of_le Hn,
  rw [nat.succ_eq_add_one, ← @nat.cast_lt ℝ _ nat_one_over_ep (n+1)] at H4,
  exact lt_of_le_of_lt (le_trans (le_ceil (1 / ep)) ((@int.cast_le ℝ _ _ _).2 (@int.le_nat_abs ⌈1 / ep⌉))) H4,
end

--We think here of sequences as functions (f : ℕ → α)
def metric_space.seq_cauchy [metric_space α] (u : ℕ → α) : Prop := cauchy (filter.map u at_top)

lemma metric_space.seq_cauchy_of_mathematician [metric_space α] (u : ℕ → α) :
metric_space.seq_cauchy u ↔ ∀ ε > 0, ∃ (N : ℕ), ∀ {n m}, n ≥ N → m ≥ N → dist (u n) (u m) < ε :=
begin
  split,
  { intros H ε Hε,
    unfold metric_space.seq_cauchy at H,
    rw cauchy_of_metric at H,
    rcases H.2 ε Hε with ⟨t, Ht, Ht2⟩,
    rw [mem_map, mem_at_top_sets] at Ht,
    cases Ht with N HN,
    existsi N,
    intros n m Hn Hm,
    exact Ht2 (u n) (u m) (HN n Hn) (HN m Hm) },
  intro H,
  unfold metric_space.seq_cauchy, rw cauchy_of_metric,
  apply and.intro _,
  { intros ε Hε,
    cases H ε Hε with N HN,
    existsi u '' {x : ℕ | N ≤ x},
    existsi _, swap,
    { rw [mem_map, mem_at_top_sets], existsi N, intros b Hb, rw [set.mem_set_of_eq, set.mem_image],
    existsi b, exact ⟨Hb, rfl⟩ },
    intros x y Hx Hy,
    rw set.mem_image at Hx,
    rw set.mem_image at Hy,
    cases Hx with n Hn,
    cases Hy with m Hm,
    have := HN Hn.1 Hm.1, rw Hn.2 at this, rw Hm.2 at this,
    assumption },
  exact map_ne_bot at_top_ne_bot,
end

def metric_space.seq_tendsto [metric_space α] (u : ℕ → α) (a : α) : Prop :=
∀ ε > 0, ∃ (N : ℕ), ∀ {n}, n ≥ N → dist (u n) a < ε

lemma metric_space.unique_limit_seq [metric_space α] (u : ℕ → α) (a b : α)
  (Ha : metric_space.seq_tendsto u a) (Hb : metric_space.seq_tendsto u b) : a = b :=
begin
  unfold metric_space.seq_tendsto at Ha,
  unfold metric_space.seq_tendsto at Hb,
  apply metric_space.eq_of_dist_eq_zero,
  by_contradiction Hnab,
  cases @dist_nonneg _ _ a b, swap, cc,
  cases Ha ((dist a b)/2) (div_pos h (by norm_num)) with N Ha1,
  cases Hb ((dist a b)/2) (div_pos h (by norm_num)) with M Hb1,
  let k := max N M,
  have Ha2 : dist (u k) a < dist a b / 2:= Ha1 (le_max_left N M),
  have Hb2 : dist (u k) b < dist a b / 2:= Hb1 (le_max_right N M),
  rw dist_comm at Ha2,
  have := add_lt_add Ha2 Hb2,
  have this2 := dist_triangle a (u k) b,
  have this3 := lt_of_le_of_lt this2 this,
  rw [← two_mul, mul_div_cancel' (dist a b) two_ne_zero] at this3,
  exact lt_irrefl (dist a b) this3,
end

lemma metric_space.cauchy_of_convergent [metric_space α] (u : ℕ → α) (H : ∃ (a : α), metric_space.seq_tendsto u a) :
  metric_space.seq_cauchy u :=
begin
  rw metric_space.seq_cauchy_of_mathematician,
  cases H with a Ha,
  intros ε Hε,
  unfold metric_space.seq_tendsto at Ha,
  cases Ha (ε / 2) (div_pos Hε (by norm_num)) with N HN,
  existsi N,
  intros n m Hn Hm,
  have dist_m := HN Hm, rw dist_comm at dist_m,
  have := add_lt_add (HN Hn) (dist_m), rw [← two_mul (ε / 2), mul_div_cancel' ε two_ne_zero] at this,
  exact lt_of_le_of_lt (dist_triangle (u n) a (u m)) this,
end

lemma subtype.seq_cauchy [metric_space α] {Y : set α} (u : ℕ → α) (H1 : ∀ (n : ℕ), u n ∈ Y) :
  metric_space.seq_cauchy u ↔ metric_space.seq_cauchy (λ (n : ℕ), (⟨u n, H1 n⟩ : Y)) :=
by rw metric_space.seq_cauchy_of_mathematician; rw metric_space.seq_cauchy_of_mathematician; refl

lemma subtype.seq_tendsto [metric_space α] {Y : set α} (u : ℕ → α) (H1 : ∀ (n : ℕ), u n ∈ Y) {a : α} (H2 : a ∈ Y) :
  metric_space.seq_tendsto u a ↔ metric_space.seq_tendsto (λ (n : ℕ), (⟨u n, H1 n⟩ : Y)) ⟨a, H2⟩ := by refl

theorem metric_space.convergent_of_cauchy_of_complete [metric_space α] (u : ℕ → α) [complete_space α]
  (H : metric_space.seq_cauchy u) :
  ∃ (x : α), metric_space.seq_tendsto u x := let ⟨a, Ha⟩ := (complete_space.complete H) in
    ⟨a, by change tendsto u at_top (nhds a) at Ha; exact (seq_tendsto_iff u a).1 Ha⟩

--Proposition 17.6
theorem closed_of_complete_subspace_of_metric {α : Type*} [metric_space α] (Y : set α) [complete_space Y] :
is_closed Y :=
begin
  rw ← closure_eq_iff_is_closed,
  apply set.eq_of_subset_of_subset,
  { intros x Hx,
    rcases lim_sequence_of_mem_closure Hx with ⟨sequence, Hxn, Hsequence⟩,
    rw seq_tendsto_iff at Hsequence,
    have Ha := metric_space.convergent_of_cauchy_of_complete (λ (n : ℕ), (⟨sequence n, Hxn n⟩ : Y))
      ((subtype.seq_cauchy sequence Hxn).1 (metric_space.cauchy_of_convergent sequence ⟨x, Hsequence⟩)),
    cases Ha with a Ha,
    change metric_space.seq_tendsto (λ (n : ℕ), (⟨sequence n, Hxn n⟩ : Y)) a at Ha,
    cases a with a ha,
    rw ← subtype.seq_tendsto at Ha,
    change metric_space.seq_tendsto sequence x at Hsequence,
    change metric_space.seq_tendsto sequence a at Ha,
    have H4 := metric_space.unique_limit_seq sequence x a Hsequence Ha,
    rw H4, exact ha },
  exact subset_closure,
end

--Lemma for following lemma
--Showing the filter definition of complete is equivalent to the sequences defintion for a metric space
lemma complete_iff_seq_complete {α : Type*} [metric_space α] :
  complete_space α ↔ ( ∀ (f : ℕ → α), cauchy (filter.map f at_top) → (∃ (a : α), tendsto f at_top (nhds a))) :=
begin
  split, intros H f Hf,
    exact (@complete_space.complete _ _ H _ Hf),
  intro H,
  split,
  intros filt Hfilt,
  rw cauchy_of_metric at Hfilt,

  have this1 : ∀ n, 0 < (↑(n + 1) : ℝ) := by intro n; rw ← nat.cast_zero; rw (@nat.cast_lt ℝ _ 0 (n+1)); exact zero_lt_iff_ne_zero.2 (nat.succ_ne_zero n),

  have this2 := λ (n : ℕ), (@div_pos ℝ _ 1 (n+1) (nat.cast_lt.2 (@zero_lt_one ℕ _)) (this1 n)),
    have this3 := λ n, (Hfilt.2 ((1 : ℝ)/(n+1 : ℕ))) (this2 n),
    have this4 := classical.axiom_of_choice (this3),

    cases this4 with f Hf, dsimp at f, dsimp at Hf,
    cases (classical.axiom_of_choice Hf) with Hf1 Hf2,
    dsimp at Hf1, dsimp at Hf2,

    have H3 : ∀ n, (f n) ≠ ∅,
      intro n,
      by_contradiction,
      rw not_not at a,
      have H2 := Hf1 n,
      rw a at H2,
      have H1 := empty_in_sets_eq_bot.1 H2,
      cc,

    have H4 : ∀ n, nonempty (f n),
    intro n,
    cases set.exists_mem_of_ne_empty (H3 n) with x Hx,
    constructor,
    exact ⟨x, Hx⟩,

    have seq_prop_better : ∀ (n : ℕ), ∃ (S : set α), (∀ (m : ℕ), m ≤ n → (S ⊆ (f m))) ∧ S ∈ filt.sets,
      intro n, induction n with N HN,
      existsi (f 0),
      exact ⟨λ n Hn, by rw (le_zero_iff_eq.1 Hn); exact (set.subset.refl (f 0)), Hf1 0⟩,
      cases HN with S0 HS0,
      existsi S0 ∩ (f (N+1)),
      refine ⟨_,inter_mem_sets HS0.2 (Hf1 (N+1))⟩,
      intro n,
      by_cases (n ≤ N),
      exact λ _ x Hx, (HS0.1 n h) Hx.1,
      rw not_le at h,
      intro Hn,

      rw (le_antisymm Hn (nat.succ_le_of_lt h)),
      intros x Hx, exact Hx.2,

    have seq_prop2 := classical.axiom_of_choice seq_prop_better, dsimp at seq_prop2,
    cases seq_prop2 with seqsets Hseqsets,

    have Hnonempty : ∀ n, nonempty (seqsets n),
      intro n,
        have Hnotempty : seqsets n ≠ ∅,
        by_contradiction,
        rw not_not at a,
        have := Hseqsets n,
        rw a at this,
        have := empty_in_sets_eq_bot.1 this.2,
        cc,
      cases set.exists_mem_of_ne_empty Hnotempty,
      constructor, exact ⟨w,h⟩,
    have seq := λ (n : ℕ), classical.choice (Hnonempty n),

    have FGI : cauchy (map (λ (n : ℕ), (seq n).val) at_top),
      rw cauchy_of_metric,
      apply and.intro (map_ne_bot at_top_ne_bot),
      intros ε Hε,
      existsi (f (int.nat_abs (ceil ((1:ℝ)/ε)))),
      have Hnext : f (int.nat_abs ⌈1 / ε⌉) ∈ (map (λ (n : ℕ), (seq n).val) at_top).sets,
        rw mem_map,
        rw mem_at_top_sets,
        existsi (int.nat_abs ⌈1 / ε⌉),
        intros m Hm,
        exact (Hseqsets m).1 (int.nat_abs ⌈1 / ε⌉) Hm (seq m).property,
      existsi Hnext,
      intros x y Hx Hy,

      have exciting := Hf2 (int.nat_abs ⌈1 / ε⌉) x y Hx Hy,
       have Hnext3 : 1/ε > 0,
            apply (mul_lt_mul_right Hε).1,
            rw one_div_eq_inv, rw zero_mul,
            rw inv_mul_cancel (ne.symm (ne_of_lt Hε)),
            exact zero_lt_one,
      have Hnext2 : ceil (1/ε) ≥ 0,
          exact le_of_lt (ceil_pos.2 Hnext3),
      have Hnext : 1 / (↑(int.nat_abs ⌈1 / ε⌉) + 1) < ε,

        rw [← int.cast_coe_nat (int.nat_abs _), int.nat_abs_of_nonneg Hnext2],
        have Hfornext4 := lt_add_one (↑⌈1 / ε⌉ : ℝ),

        have Hnext4 : (1 : ℝ) / (↑⌈1 / ε⌉ + 1) < 1 / (↑⌈1 / ε⌉),
          exact one_div_lt_one_div_of_lt (int.cast_lt.2 (ceil_pos.2 Hnext3)) Hfornext4,
        apply lt_of_lt_of_le Hnext4,
        have Hnext5 := le_ceil (1/ε),
        have Hnext6 := one_div_le_one_div_of_le Hnext3 Hnext5,
        apply le_trans Hnext6,
        simp,
        exact lt_trans exciting Hnext,
        exact ⟨0⟩,

  have := H (λ n, (seq n).1) FGI,
  cases this with a Ha,
  existsi a,
  unfold tendsto at Ha,
  intros S HS,

  rcases mem_nhds_sets_iff.1 HS with ⟨S1, HS1, H2S1⟩,
  rcases is_open_metric.1 H2S1.1 a H2S1.2 with ⟨ε, Hε, Hballε⟩,

  have Hepover2 : ε/2 > 0 := div_pos Hε (by norm_num),
  cases (seq_tendsto_iff (λ (n : ℕ), (seq n).val) a).1 Ha (ε/2) Hepover2 with N1 HN1,

  let N := max N1 (int.nat_abs ⌈2 / ε⌉),

  have HS3 : f N ⊆ ball a ε,
    intros x Hx,
    rw mem_ball,
    dsimp at HN1,
    have distance1 := Hf2 N x (seq N).val Hx ((Hseqsets N).1 N (le_refl N) (seq N).property),
    have lt_εover2 : 1 / (↑N + 1) < ε / 2,
      have le_somth := le_max_right N1 (int.nat_abs ⌈2 / ε⌉),
      have twoovereplt : 2 / ε < ↑(nat.succ N),
        apply lt_of_le_of_lt (le_ceil (2/ε)),
        have N_ge_ceil : int.nat_abs ⌈2 / ε⌉ ≤ N,
        exact le_max_right _ _,
        have N_ge_ceil2 : ((int.nat_abs ⌈2 / ε⌉) : ℝ) ≤ ↑N := nat.cast_le.2 N_ge_ceil,
        have zero_le_ceiltwooverep : (0 : ℤ) ≤ ⌈2 / ε⌉,
        have zero_lt_twooverep : 0 < 2/ε,
        have := div_div_eq_mul_div 1 2 ε,
        simp at this,
        rw ← this at Hepover2,
        exact inv_pos'.1 Hepover2,
        apply int.cast_le.1,
        refine le_of_lt (lt_of_lt_of_le zero_lt_twooverep _),
        exact le_ceil _,

        have := int.nat_abs_of_nonneg zero_le_ceiltwooverep,
        change (((int.nat_abs ⌈2 / ε⌉) : ℤ) : ℝ) ≤ _ at N_ge_ceil2,
        rw this at N_ge_ceil2,
        refine lt_of_le_of_lt N_ge_ceil2 _,
        simp [zero_lt_one],

      have := (inv_lt_inv  (nat.cast_lt.2 (nat.zero_lt_succ N) : (0 : ℝ) < _)
        (div_pos (by norm_num) Hε : (2 : ℝ)/ε > 0)).2 twoovereplt,
      rw inv_eq_one_div at this, rw inv_eq_one_div at this,
      rw div_div_eq_mul_div at this, rw one_mul at this,
      exact this,

    have distance2 := HN1 (le_max_left N1 (int.nat_abs ⌈2 / ε⌉)),
    have distance3 := dist_triangle x (seq N).val a,
    have distance4 := add_lt_add (lt_trans distance1 lt_εover2) distance2,
    have distance5 := lt_of_le_of_lt distance3 distance4,
    rw add_halves at distance5, exact distance5,

  apply mem_sets_of_superset (Hf1 N),
  exact set.subset.trans (set.subset.trans HS3 Hballε) HS1,

end

--Proposition 17.7
theorem complete_of_closed_subspace_of_complete {α : Type*} [metric_space α] [complete_space α]
(Y : set α) (HY : is_closed Y) : complete_space Y :=
begin
  rw complete_iff_seq_complete,
  intros f Hf,
  rw complete_iff_seq_complete at _inst_2,
  have : metric_space.seq_cauchy f := Hf,
  have this2 : f = (λ (n : ℕ), (⟨(f n).val, (f n).property⟩ : Y)),
  { simp },
  rw this2 at this,
  cases _inst_2 (λ n, (f n).val) ((subtype.seq_cauchy _ _).2 this) with a Ha,
  have H2 : a ∈ Y,
  { apply mem_of_closed_of_tendsto at_top_ne_bot Ha HY,
  rw mem_at_top_sets, existsi 0, exact λ n _, (f n).property },
  existsi (⟨a, H2⟩ : Y),
  have H3 := subtype.seq_tendsto (λ n, (f n).val) (λ n, (f n).property) H2,
  simp at H3,
  rw seq_tendsto_iff,
  apply H3.1,
  exact (seq_tendsto_iff (λ (n : ℕ), (f n).val) a).1 Ha
end

def subseq {α : Type*} (f : ℕ → α) (u : ℕ → α) := ∃ (map : ℕ → ℕ), u = f ∘ map ∧ tendsto map at_top at_top
--tendsto map at_top at_top is the same as being a subsequence, but we don't require strict increasingness

--Prop 17.10
theorem convergent_of_cauchy_of_subseq_convergent {α : Type*} [metric_space α] {f : ℕ → α} (H : cauchy (filter.map f at_top))
 {sub : ℕ → α} (H1 : subseq sub f) {x : α} (H2 : metric_space.seq_tendsto sub x) : metric_space.seq_tendsto f x :=
begin
  unfold subseq at H1,
  cases H1 with map Hmap,
  rw Hmap.1,
  unfold tendsto at Hmap,
  unfold metric_space.seq_tendsto, rw ← seq_tendsto_iff,
  unfold metric_space.seq_tendsto at H2, rw ← seq_tendsto_iff at H2,
  apply tendsto.comp,
  { exact tendsto_id },
  apply tendsto.comp,
  { exact Hmap.2 },
  exact H2,
end

theorem convergent_of_cauchy_of_subseq_convergent' {α : Type*} [metric_space α] {f : ℕ → α} (H : cauchy (filter.map f at_top))
 {sub : ℕ → α} (H1 : subseq sub f) {x : α} (H2 : metric_space.seq_tendsto sub x) : metric_space.seq_tendsto f x :=
begin
  cases H1 with map Hmap,
  rw Hmap.1, unfold tendsto at Hmap, unfold metric_space.seq_tendsto,
  rw ← seq_tendsto_iff,
  unfold metric_space.seq_tendsto at H2,
  rw ← seq_tendsto_iff at H2, exact tendsto.comp tendsto_id (tendsto.comp Hmap.2 H2),
end