/-
Copyright (c) 2015 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Robert Y. Lewis
-/
import data.nat.basic
import tactic.monotonicity.basic
import group_theory.group_action.defs

/-!
# Power operations on monoids and groups

The power operation on monoids and groups.
We separate this from group, because it depends on `ℕ`,
which in turn depends on other parts of algebra.

This module contains lemmas about `a ^ n` and `n • a`, where `n : ℕ` or `n : ℤ`.
Further lemmas can be found in `algebra.group_power.lemmas`.

## Notation

- `a ^ n` is used as notation for `has_pow.pow a n`; in this file `n : ℕ` or `n : ℤ`.
- `n • a` is used as notation for `has_scalar.smul n a`; in this file `n : ℕ` or `n : ℤ`.

## Implementation details

We adopt the convention that `0^0 = 1`.
-/

universes u v w x y z u₁ u₂

variables {M : Type u} {N : Type v} {G : Type w} {H : Type x} {A : Type y} {B : Type z}
  {R : Type u₁} {S : Type u₂}

/-!
### Commutativity

First we prove some facts about `semiconj_by` and `commute`. They do not require any theory about
`pow` and/or `nsmul` and will be useful later in this file.
-/

section monoid
variables [monoid M] [monoid N] [add_monoid A] [add_monoid B]

@[simp, to_additive one_nsmul]
theorem pow_one (a : M) : a^1 = a :=
by rw [pow_succ, pow_zero, mul_one]

/-- Note that most of the lemmas about powers of two refer to it as `sq`. -/
@[to_additive two_nsmul]
theorem pow_two (a : M) : a^2 = a * a :=
by rw [pow_succ, pow_one]

alias pow_two ← sq

@[to_additive nsmul_add_comm']
theorem pow_mul_comm' (a : M) (n : ℕ) : a^n * a = a * a^n := commute.pow_self a n

@[to_additive add_nsmul]
theorem pow_add (a : M) (m n : ℕ) : a^(m + n) = a^m * a^n :=
by induction n with n ih; [rw [nat.add_zero, pow_zero, mul_one],
  rw [pow_succ', ← mul_assoc, ← ih, ← pow_succ', nat.add_assoc]]

@[simp] lemma pow_ite (P : Prop) [decidable P] (a : M) (b c : ℕ) :
  a ^ (if P then b else c) = if P then a ^ b else a ^ c :=
by split_ifs; refl

@[simp] lemma ite_pow (P : Prop) [decidable P] (a b : M) (c : ℕ) :
  (if P then a else b) ^ c = if P then a ^ c else b ^ c :=
by split_ifs; refl

@[simp] lemma pow_boole (P : Prop) [decidable P] (a : M) :
  a ^ (if P then 1 else 0) = if P then a else 1 :=
by simp

-- the attributes are intentionally out of order. `smul_zero` proves `nsmul_zero`.
@[to_additive nsmul_zero, simp] theorem one_pow (n : ℕ) : (1 : M)^n = 1 :=
by induction n with n ih; [exact pow_zero _, rw [pow_succ, ih, one_mul]]

@[to_additive mul_nsmul']
theorem pow_mul (a : M) (m n : ℕ) : a^(m * n) = (a^m)^n :=
begin
  induction n with n ih,
  { rw [nat.mul_zero, pow_zero, pow_zero] },
  { rw [nat.mul_succ, pow_add, pow_succ', ih] }
end

@[to_additive nsmul_left_comm]
lemma pow_right_comm (a : M) (m n : ℕ) : (a^m)^n = (a^n)^m :=
by rw [←pow_mul, nat.mul_comm, pow_mul]

@[to_additive mul_nsmul]
theorem pow_mul' (a : M) (m n : ℕ) : a^(m * n) = (a^n)^m :=
by rw [nat.mul_comm, pow_mul]

@[to_additive nsmul_add_sub_nsmul]
theorem pow_mul_pow_sub (a : M) {m n : ℕ} (h : m ≤ n) : a ^ m * a ^ (n - m) = a ^ n :=
by rw [←pow_add, nat.add_comm, tsub_add_cancel_of_le h]

@[to_additive sub_nsmul_nsmul_add]
theorem pow_sub_mul_pow (a : M) {m n : ℕ} (h : m ≤ n) : a ^ (n - m) * a ^ m = a ^ n :=
by rw [←pow_add, tsub_add_cancel_of_le h]

@[to_additive bit0_nsmul]
theorem pow_bit0 (a : M) (n : ℕ) : a ^ bit0 n = a^n * a^n := pow_add _ _ _

@[to_additive bit1_nsmul]
theorem pow_bit1 (a : M) (n : ℕ) : a ^ bit1 n = a^n * a^n * a :=
by rw [bit1, pow_succ', pow_bit0]

@[to_additive nsmul_add_comm]
theorem pow_mul_comm (a : M) (m n : ℕ) : a^m * a^n = a^n * a^m :=
commute.pow_pow_self a m n

@[to_additive]
lemma commute.mul_pow {a b : M} (h : commute a b) (n : ℕ) : (a * b) ^ n = a ^ n * b ^ n :=
nat.rec_on n (by simp only [pow_zero, one_mul]) $ λ n ihn,
by simp only [pow_succ, ihn, ← mul_assoc, (h.pow_left n).right_comm]

theorem neg_pow [ring R] (a : R) (n : ℕ) : (- a) ^ n = (-1) ^ n * a ^ n :=
(neg_one_mul a) ▸ (commute.neg_one_left a).mul_pow n

@[to_additive bit0_nsmul']
theorem pow_bit0' (a : M) (n : ℕ) : a ^ bit0 n = (a * a) ^ n :=
by rw [pow_bit0, (commute.refl a).mul_pow]

@[to_additive bit1_nsmul']
theorem pow_bit1' (a : M) (n : ℕ) : a ^ bit1 n = (a * a) ^ n * a :=
by rw [bit1, pow_succ', pow_bit0']

@[simp] theorem neg_pow_bit0 [ring R] (a : R) (n : ℕ) : (- a) ^ (bit0 n) = a ^ (bit0 n) :=
by rw [pow_bit0', neg_mul_neg, pow_bit0']

@[simp] theorem neg_pow_bit1 [ring R] (a : R) (n : ℕ) : (- a) ^ (bit1 n) = - a ^ (bit1 n) :=
by simp only [bit1, pow_succ, neg_pow_bit0, neg_mul_eq_neg_mul]

end monoid

/-!
### Commutative (additive) monoid
-/

section comm_monoid
variables [comm_monoid M] [add_comm_monoid A]

@[to_additive nsmul_add]
theorem mul_pow (a b : M) (n : ℕ) : (a * b)^n = a^n * b^n :=
(commute.all a b).mul_pow n

/-- The `n`th power map on a commutative monoid for a natural `n`, considered as a morphism of
monoids. -/
@[to_additive nsmul_add_monoid_hom "Multiplication by a natural `n` on a commutative additive
monoid, considered as a morphism of additive monoids.", simps]
def pow_monoid_hom (n : ℕ) : M →* M :=
{ to_fun := (^ n),
  map_one' := one_pow _,
  map_mul' := λ a b, mul_pow a b n }

-- the below line causes the linter to complain :-/
-- attribute [simps] pow_monoid_hom nsmul_add_monoid_hom

lemma dvd_pow {x y : M} (hxy : x ∣ y) :
  ∀ {n : ℕ} (hn : n ≠ 0), x ∣ y^n
| 0       hn := (hn rfl).elim
| (n + 1) hn := by { rw pow_succ, exact hxy.mul_right _ }

alias dvd_pow ← has_dvd.dvd.pow

lemma dvd_pow_self (a : M) {n : ℕ} (hn : n ≠ 0) : a ∣ a^n :=
dvd_rfl.pow hn

end comm_monoid

section div_inv_monoid
variable [div_inv_monoid G]

open int

@[simp, to_additive one_zsmul]
theorem zpow_one (a : G) : a ^ (1:ℤ) = a :=
by { convert pow_one a using 1, exact zpow_coe_nat a 1 }

theorem zpow_two (a : G) : a ^ (2 : ℤ) = a * a :=
by { convert pow_two a using 1, exact zpow_coe_nat a 2 }

end div_inv_monoid

section group
variables [group G] [group H] [add_group A] [add_group B]

open int

section nat

@[simp, to_additive neg_nsmul] theorem inv_pow (a : G) (n : ℕ) : (a⁻¹)^n = (a^n)⁻¹ :=
begin
  induction n with n ih,
  { rw [pow_zero, pow_zero, one_inv] },
  { rw [pow_succ', pow_succ, ih, mul_inv_rev] }
end

@[to_additive nsmul_sub] -- rename to sub_nsmul?
theorem pow_sub (a : G) {m n : ℕ} (h : n ≤ m) : a^(m - n) = a^m * (a^n)⁻¹ :=
have h1 : m - n + n = m, from tsub_add_cancel_of_le h,
have h2 : a^(m - n) * a^n = a^m, by rw [←pow_add, h1],
eq_mul_inv_of_mul_eq h2

@[to_additive nsmul_neg_comm]
theorem pow_inv_comm (a : G) (m n : ℕ) : (a⁻¹)^m * a^n = a^n * (a⁻¹)^m :=
(commute.refl a).inv_left.pow_pow m n

@[to_additive sub_nsmul_neg]
theorem inv_pow_sub (a : G) {m n : ℕ} (h : n ≤ m) : a⁻¹^(m - n) = (a^m)⁻¹ * a^n :=
by rw [pow_sub a⁻¹ h, inv_pow, inv_pow, inv_inv]

end nat

@[simp, to_additive zsmul_zero]
theorem one_zpow : ∀ (n : ℤ), (1 : G) ^ n = 1
| (n : ℕ) := by rw [zpow_coe_nat, one_pow]
| -[1+ n] := by rw [zpow_neg_succ_of_nat, one_pow, one_inv]

@[simp, to_additive neg_zsmul]
theorem zpow_neg (a : G) : ∀ (n : ℤ), a ^ -n = (a ^ n)⁻¹
| (n+1:ℕ) := div_inv_monoid.zpow_neg' _ _
| 0       := by { change a ^ (0 : ℤ) = (a ^ (0 : ℤ))⁻¹, simp }
| -[1+ n] := by { rw [zpow_neg_succ_of_nat, inv_inv, ← zpow_coe_nat], refl }

@[to_additive neg_one_zsmul_add] lemma mul_zpow_neg_one (a b : G) :
  (a*b)^(-(1:ℤ)) = b^(-(1:ℤ))*a^(-(1:ℤ)) :=
by simp only [mul_inv_rev, zpow_one, zpow_neg]

@[to_additive neg_one_zsmul]
theorem zpow_neg_one (x : G) : x ^ (-1:ℤ) = x⁻¹ :=
by { rw [← congr_arg has_inv.inv (pow_one x), zpow_neg, ← zpow_coe_nat], refl }

@[to_additive zsmul_neg]
theorem inv_zpow (a : G) : ∀n:ℤ, a⁻¹ ^ n = (a ^ n)⁻¹
| (n : ℕ) := by rw [zpow_coe_nat, zpow_coe_nat, inv_pow]
| -[1+ n] := by rw [zpow_neg_succ_of_nat, zpow_neg_succ_of_nat, inv_pow]

@[to_additive add_commute.zsmul_add]
theorem commute.mul_zpow {a b : G} (h : commute a b) : ∀ n : ℤ, (a * b) ^ n = a ^ n * b ^ n
| (n : ℕ) := by simp [zpow_coe_nat, h.mul_pow n]
| -[1+n]  := by simp [h.mul_pow, (h.pow_pow n.succ n.succ).inv_inv.symm.eq]

end group

section comm_group
variables [comm_group G] [add_comm_group A]

@[to_additive zsmul_add]
theorem mul_zpow (a b : G) (n : ℤ) : (a * b)^n = a^n * b^n := (commute.all a b).mul_zpow n

@[to_additive zsmul_sub]
theorem div_zpow (a b : G) (n : ℤ) : (a / b) ^ n = a ^ n / b ^ n :=
by rw [div_eq_mul_inv, div_eq_mul_inv, mul_zpow, inv_zpow]

/-- The `n`th power map (`n` an integer) on a commutative group, considered as a group
homomorphism. -/
@[to_additive "Multiplication by an integer `n` on a commutative additive group, considered as an
additive group homomorphism.", simps]
def zpow_group_hom (n : ℤ) : G →* G :=
{ to_fun := (^ n),
  map_one' := one_zpow n,
  map_mul' := λ a b, mul_zpow a b n }

end comm_group

lemma zero_pow [monoid_with_zero R] : ∀ {n : ℕ}, 0 < n → (0 : R) ^ n = 0
| (n+1) _ := by rw [pow_succ, zero_mul]

lemma zero_pow_eq [monoid_with_zero R] (n : ℕ) : (0 : R)^n = if n = 0 then 1 else 0 :=
begin
  split_ifs with h,
  { rw [h, pow_zero], },
  { rw [zero_pow (nat.pos_of_ne_zero h)] },
end

lemma pow_eq_zero_of_le [monoid_with_zero M] {x : M} {n m : ℕ}
  (hn : n ≤ m) (hx : x^n = 0) : x^m = 0 :=
by rw [← tsub_add_cancel_of_le hn, pow_add, hx, mul_zero]

namespace ring_hom

variables [semiring R] [semiring S]

@[simp] lemma map_pow (f : R →+* S) (a) :
  ∀ n : ℕ, f (a ^ n) = (f a) ^ n :=
f.to_monoid_hom.map_pow a

end ring_hom

section
variables (R)

theorem neg_one_pow_eq_or [ring R] : ∀ n : ℕ, (-1 : R)^n = 1 ∨ (-1 : R)^n = -1
| 0     := or.inl (pow_zero _)
| (n+1) := (neg_one_pow_eq_or n).swap.imp
  (λ h, by rw [pow_succ, h, neg_one_mul, neg_neg])
  (λ h, by rw [pow_succ, h, mul_one])

end

@[simp]
lemma neg_one_pow_mul_eq_zero_iff [ring R] {n : ℕ} {r : R} : (-1)^n * r = 0 ↔ r = 0 :=
by rcases neg_one_pow_eq_or R n; simp [h]

@[simp]
lemma mul_neg_one_pow_eq_zero_iff [ring R] {n : ℕ} {r : R} : r * (-1)^n = 0 ↔ r = 0 :=
by rcases neg_one_pow_eq_or R n; simp [h]

lemma pow_dvd_pow [monoid R] (a : R) {m n : ℕ} (h : m ≤ n) :
  a ^ m ∣ a ^ n := ⟨a ^ (n - m), by rw [← pow_add, nat.add_comm, tsub_add_cancel_of_le h]⟩

theorem pow_dvd_pow_of_dvd [comm_monoid R] {a b : R} (h : a ∣ b) : ∀ n : ℕ, a ^ n ∣ b ^ n
| 0     := by rw [pow_zero, pow_zero]
| (n+1) := by { rw [pow_succ, pow_succ], exact mul_dvd_mul h (pow_dvd_pow_of_dvd n) }

lemma sq_sub_sq {R : Type*} [comm_ring R] (a b : R) :
  a ^ 2 - b ^ 2 = (a + b) * (a - b) :=
by rw [sq, sq, mul_self_sub_mul_self]

alias sq_sub_sq ← pow_two_sub_pow_two

lemma eq_or_eq_neg_of_sq_eq_sq [comm_ring R] [is_domain R] (a b : R) (h : a ^ 2 = b ^ 2) :
  a = b ∨ a = -b :=
by rwa [← add_eq_zero_iff_eq_neg, ← sub_eq_zero, or_comm, ← mul_eq_zero,
        ← sq_sub_sq a b, sub_eq_zero]

theorem pow_eq_zero [monoid_with_zero R] [no_zero_divisors R] {x : R} {n : ℕ} (H : x^n = 0) :
  x = 0 :=
begin
  induction n with n ih,
  { rw pow_zero at H,
    rw [← mul_one x, H, mul_zero] },
  { rw pow_succ at H,
    exact or.cases_on (mul_eq_zero.1 H) id ih }
end

@[simp] lemma pow_eq_zero_iff [monoid_with_zero R] [no_zero_divisors R]
  {a : R} {n : ℕ} (hn : 0 < n) :
  a ^ n = 0 ↔ a = 0 :=
begin
  refine ⟨pow_eq_zero, _⟩,
  rintros rfl,
  exact zero_pow hn,
end

lemma pow_ne_zero_iff [monoid_with_zero R] [no_zero_divisors R] {a : R} {n : ℕ} (hn : 0 < n) :
  a ^ n ≠ 0 ↔ a ≠ 0 :=
by rwa [not_iff_not, pow_eq_zero_iff]

@[field_simps] theorem pow_ne_zero [monoid_with_zero R] [no_zero_divisors R]
  {a : R} (n : ℕ) (h : a ≠ 0) : a ^ n ≠ 0 :=
mt pow_eq_zero h

section semiring

variables [semiring R]

lemma min_pow_dvd_add {n m : ℕ} {a b c : R} (ha : c ^ n ∣ a) (hb : c ^ m ∣ b) :
  c ^ (min n m) ∣ a + b :=
begin
  replace ha := (pow_dvd_pow c (min_le_left n m)).trans ha,
  replace hb := (pow_dvd_pow c (min_le_right n m)).trans hb,
  exact dvd_add ha hb
end

end semiring

section comm_semiring

variables [comm_semiring R]

lemma add_sq (a b : R) : (a + b) ^ 2 = a ^ 2 + 2 * a * b + b ^ 2 :=
by simp only [sq, add_mul_self_eq]

alias add_sq ← add_pow_two

end comm_semiring

@[simp] lemma neg_sq {α} [ring α] (z : α) : (-z)^2 = z^2 :=
by simp [sq]

alias neg_sq ← neg_pow_two

lemma sub_sq {R} [comm_ring R] (a b : R) : (a - b) ^ 2 = a ^ 2 - 2 * a * b + b ^ 2 :=
by rw [sub_eq_add_neg, add_sq, neg_sq, mul_neg_eq_neg_mul_symm, ← sub_eq_add_neg]

alias sub_sq ← sub_pow_two

lemma of_add_nsmul [add_monoid A] (x : A) (n : ℕ) :
  multiplicative.of_add (n • x) = (multiplicative.of_add x)^n := rfl

lemma of_add_zsmul [add_group A] (x : A) (n : ℤ) :
  multiplicative.of_add (n • x) = (multiplicative.of_add x)^n := rfl

lemma of_mul_pow {A : Type*} [monoid A] (x : A) (n : ℕ) :
  additive.of_mul (x ^ n) = n • (additive.of_mul x) := rfl

lemma of_mul_zpow [group G] (x : G) (n : ℤ) : additive.of_mul (x ^ n) = n • additive.of_mul x :=
rfl

@[simp] lemma semiconj_by.zpow_right [group G] {a x y : G} (h : semiconj_by a x y) :
  ∀ m : ℤ, semiconj_by a (x^m) (y^m)
| (n : ℕ) := by simp [zpow_coe_nat, h.pow_right n]
| -[1+n] := by simp [(h.pow_right n.succ).inv_right]

namespace commute

variables [group G] {a b : G}

@[simp] lemma zpow_right (h : commute a b) (m : ℤ) : commute a (b^m) :=
h.zpow_right m

@[simp] lemma zpow_left (h : commute a b) (m : ℤ) : commute (a^m) b :=
(h.symm.zpow_right m).symm

lemma zpow_zpow (h : commute a b) (m n : ℤ) : commute (a^m) (b^n) := (h.zpow_left m).zpow_right n

variables (a) (m n : ℤ)

@[simp] theorem self_zpow : commute a (a ^ n) := (commute.refl a).zpow_right n
@[simp] theorem zpow_self : commute (a ^ n) a := (commute.refl a).zpow_left n
@[simp] theorem zpow_zpow_self : commute (a ^ m) (a ^ n) := (commute.refl a).zpow_zpow m n

end commute


import group_theory.quotient_group
import group_theory.subgroup.basic

variables {G : Type*} [group G]

def subgroup_generated_by (S : set G) : subgroup G :=
⨅ (H : subgroup G) (hH : S ⊆ H), H

include G
def foo : ℕ → ℕ := λ a, a

namespace subgroup_gen

inductive carrier (S : set G) : set G
| of (s : G) (hs : s ∈ S) : carrier s
| one : carrier 1
| mul {x y : G} : carrier x → carrier y → carrier (x * y)
| inv {x : G} : carrier x → carrier x⁻¹

end subgroup_gen

open subgroup_gen

def subgroup_gen (S : set G) : subgroup G :=
{ carrier := carrier S,
  mul_mem' := λ a b ha hb, carrier.mul ha hb,
  one_mem' := carrier.one,
  inv_mem' := λ x hx, carrier.inv hx }

example (S : set G) : subgroup_generated_by S = subgroup_gen S :=
begin
  apply le_antisymm,
  { intros x hx, unfold subgroup_generated_by at hx,
    simp_rw subgroup.mem_infi at hx,
    apply hx,
    intros s hs,
    apply carrier.of,
    exact hs },
  { intros x hx, unfold subgroup_generated_by,
    simp_rw subgroup.mem_infi,
    intros H hH,
    induction hx,
    case carrier.of : s hs { apply hH, exact hs },
    case carrier.one { exact H.one_mem },
    case carrier.mul : a b h1 h2 hh1 hh2 { apply H.mul_mem, exact hh1, exact hh2 },
    case carrier.inv : a _ ha { apply H.inv_mem, exact ha } }
end

/-!
QUOTIENTS
-/

variable (R : G → G → Prop)

/-!

I want to construct the smallest relation `S : G → G → Prop`
which satisfies the following properties:
1. It should be implied by `R`, meaning if `R a b` then `S a b` should also hold true.
2. `S` is an equivalence relation.
3. `G/S` is a group where the product has the form `[a] * [b] = [a * b]` and inversion
  has the form `[a]⁻¹ = [a⁻¹]`.
-/

inductive congr_rel (R : G → G → Prop) : G → G → Prop
| of (x y : G) (h : R x y) : congr_rel x y
| refl (x : G) : congr_rel x x
| symm (x y : G) : congr_rel x y → congr_rel y x
| trans (x y z : G) : congr_rel x y → congr_rel y z → congr_rel x z
| inv (x y : G) : congr_rel x y → congr_rel x⁻¹ y⁻¹
| mul (x x' y y' : G) : congr_rel x x' → congr_rel y y' → congr_rel (x * y) (x' * y')

def congr_setoid (R : G → G → Prop) : setoid G :=
{ r := congr_rel R,
  iseqv := begin
    refine ⟨_,_,_⟩,
    { apply congr_rel.refl, },
    { apply congr_rel.symm },
    { apply congr_rel.trans },
  end }

def quotient_group (R : G → G → Prop) := quotient (congr_setoid R)

instance : group (quotient_group R) :=
{ mul := λ a b, quotient.lift_on₂' a b (λ x y, quotient.mk' $ x * y) begin
    intros a₁ a₂ b₁ b₂ h1 h2,
    dsimp,
    apply quotient.sound',
    apply congr_rel.mul,
    exact h1,
    exact h2,
  end,
  mul_assoc := begin
    rintros ⟨a⟩ ⟨b⟩ ⟨c⟩,
    apply quotient.sound',
    rw mul_assoc,
    apply setoid.refl',
  end,
  one := quotient.mk' 1,
  one_mul := begin
    rintros ⟨a⟩,
    apply quotient.sound',
    rw one_mul,
    apply setoid.refl',
  end,
  mul_one := begin
    rintros ⟨a⟩,
    apply quotient.sound',
    rw mul_one,
    apply setoid.refl',
  end,
  inv := λ x, quotient.lift_on' x (λ g, quotient.mk' g⁻¹) begin
    intros a b h,
    dsimp,
    apply quotient.sound',
    apply congr_rel.inv,
    exact h,
  end,
  mul_left_inv := begin
    rintros ⟨a⟩,
    apply quotient.sound',
    rw mul_left_inv,
    apply setoid.refl',
  end }

def π : G →* quotient_group R :=
{ to_fun := quotient.mk',
  map_one' := rfl,
  map_mul' := λ a b, rfl }

def desc_to_quotient
  {H : Type*} [group H]
  (f : G →* H)
  (hf : ∀ a b : G, R a b → f a = f b) :
  quotient_group R →* H :=
{ to_fun := λ x, quotient.lift_on' x f begin
    intros a b h,
    induction h,
    case congr_rel.of : a b h { apply hf, assumption },
    case congr_rel.refl { refl },
    case congr_rel.symm { symmetry, assumption },
    case congr_rel.trans { cc },
    case congr_rel.inv : a b h hh { simp_rw [f.map_inv, hh], },
    case congr_rel.mul : a a' b b' h hh h1 h2 { simp_rw [f.map_mul, h1, h2] }
  end,
  map_one' := f.map_one,
  map_mul' := begin
    rintros ⟨a⟩ ⟨b⟩,
    apply f.map_mul,
  end }

theorem universal_property_of_the_quotient_by_a_relation
  {H : Type*} [group H]
  (f : G →* H)
  (hf : ∀ a b : G, R a b → f a = f b) :
  ((desc_to_quotient R f hf).comp (π R) = f) ∧
  (∀ (g : quotient_group R →* H) (hg : g.comp (π R) = f), g = desc_to_quotient R f hf) :=
begin
  split,
  { ext, refl, },
  { intros g hg,
    ext ⟨t⟩,
    apply_fun (λ e, e t) at hg,
    exact hg }
end


import fibonacci_world.divides_mul -- hide
/-
## Divisibility of a sum

In the quest for proving an interesting result about Fibonacci numbers
it will be useful to have the following lemma, that allows to deduce
the divibility of a sum from the divisibility of the summands.
-/

/- Lemma :
If $k$ divides $n$ and $m$, then $k$ divides $m + n$.
-/
lemma divides_add {k n m : ℕ} (hn : k ∣ n) (hm : k ∣ m) : k ∣ m + n :=
begin
  cases hn with n1 hn1,
  cases hm with m1 hm1,
  use n1 + m1,
  rw hn1,
  rw hm1,
  ring,

end


import .love01_definitions_and_statements_demo

/-! # LoVe Demo 3: Forward Proofs

When developing a proof, often it makes sense to work __forward__: to start with
what we already know and proceed step by step towards our goal. Structured
proofs are a style that supports this reasoning. -/

set_option pp.beta true

namespace LoVe

/-! ## Structured Constructs

Structured proofs are syntactic sugar sprinkled on top of Lean's
__proof terms__.

The simplest kind of structured proof is the name of a lemma, possibly with
arguments. -/

lemma add_comm_zero_left (n : ℕ) :
  0 + n = n + 0 :=
begin
  apply add_comm 0 n
end

lemma add_comm_zero_left₂ (n : ℕ) :
  0 + n = n + 0 :=
by exact add_comm 0 n

/-! `fix` and `assume` move `∀`-quantified variables and assumptions from the
goal into the local context. They can be seen as structured versions of the
`intros` tactic.

`show` repeats the goal to prove. It is useful as documentation or to rephrase
the goal (up to computation). -/

lemma fst_of_two_props :
  ∀a b : Prop, a → b → a :=
fix a b : Prop,
assume ha : a,
assume hb : b,
show a, from
  ha

lemma fst_of_two_props₂ (a b : Prop) (ha : a) (hb : b) :
  a :=
show a, from
  begin
    exact ha
  end

lemma fst_of_two_props₃ (a b : Prop) (ha : a) (hb : b) :
  a :=
ha

/-! `have` proves an intermediate lemma, which can refer to the local
context. -/

lemma prop_comp (a b c : Prop) (hab : a → b) (hbc : b → c) :
  a → c :=
assume ha : a,
have hb : b :=
  hab ha,
have hc : c :=
  hbc hb,
show c, from
  hc

lemma prop_comp₂ (a b c : Prop) (hab : a → b) (hbc : b → c) :
  a → c :=
assume ha : a,
show c, from
  hbc (hab ha)

/-! ## Forward Reasoning about Connectives and Quantifiers -/

lemma and_swap (a b : Prop) :
  a ∧ b → b ∧ a :=
assume hab : a ∧ b,
have ha : a :=
  and.elim_left hab,
have hb : b :=
  and.elim_right hab,
show b ∧ a, from
  and.intro hb ha

lemma or_swap (a b : Prop) :
  a ∨ b → b ∨ a :=
assume hab : a ∨ b,
show b ∨ a, from
  or.elim hab
    (assume ha : a,
     show b ∨ a, from
       or.intro_right b ha)
    (assume hb : b,
     show b ∨ a, from
       or.intro_left a hb)

def double (n : ℕ) : ℕ :=
n + n

lemma nat_exists_double_iden :
  ∃n : ℕ, double n = n :=
exists.intro 0
  (show double 0 = 0, from
     by refl)

lemma nat_exists_double_iden₂ :
  ∃n : ℕ, double n = n :=
exists.intro 0 (by refl)

lemma modus_ponens (a b : Prop) :
  (a → b) → a → b :=
λ hab : a → b,
λ ha : a,
show b, from
  hab ha

lemma not_not_intro (a : Prop) :
  a → ¬¬ a :=
λ ha : a,
λ hna : ¬ a,
show false, from
  begin
    apply hna ha,
  end

lemma forall.one_point {α : Type} (t : α) (p : α → Prop) :
  (∀x, x = t → p x) ↔ p t :=
iff.intro
  (assume hall : ∀x, x = t → p x,
   show p t, from
     begin
       apply hall t,
       refl
     end)
  (assume hp : p t,
   fix x,
   assume heq : x = t,
   show p x, from
     begin
       rewrite heq,
       exact hp
     end)

lemma beast_666 (beast : ℕ) :
  (∀n, n = 666 → beast ≥ n) ↔ beast ≥ 666 :=
forall.one_point _ _

#print beast_666

lemma exists.one_point {α : Type} (t : α) (p : α → Prop) :
  (∃x : α, x = t ∧ p x) ↔ p t :=
iff.intro
  (assume hex : ∃x, x = t ∧ p x,
   show p t, from
     exists.elim hex
       (fix x,
        assume hand : x = t ∧ p x,
        show p t, from
          by cc))
  (assume hp : p t,
   show ∃x : α, x = t ∧ p x, from
     exists.intro t
       (show t = t ∧ p t, from
          by cc))

/-! ## Calculational Proofs

In informal mathematics, we often use transitive chains of equalities,
inequalities, or equivalences (e.g., `a ≥ b ≥ c`). In Lean, such calculational
proofs are supported by `calc`.

Syntax:

    calc      _term₀_
        _op₁_ _term₁_ :
      _proof₁_
    ... _op₂_ _term₂_ :
      _proof₂_
     ⋮
    ... _opN_ _termN_ :
      _proofN_ -/

lemma two_mul_example (m n : ℕ) :
  2 * m + n = m + n + m :=
calc  2 * m + n
    = (m + m) + n :
  by rewrite two_mul
... = m + n + m :
  by cc

/-! `calc` saves some repetition, some `have` labels, and some transitive
reasoning: -/

lemma two_mul_example₂ (m n : ℕ) :
  2 * m + n = m + n + m :=
have h₁ : 2 * m + n = (m + m) + n :=
  by rewrite two_mul,
have h₂ : (m + m) + n = m + n + m :=
  by cc,
show _, from
  eq.trans h₁ h₂

/-! ## Forward Tactics

The `have` and `let` structured proof commands are also available as a tactic.
Even in tactic mode, it can be useful to state intermediate results and
definitions in a forward fashion.

Observe that the syntax for the tactic `let` is slightly different than for the
structured proof command `let`, with `,` instead of `in`. -/

lemma prop_comp₃ (a b c : Prop) (hab : a → b) (hbc : b → c) :
  a → c :=
begin
  intro ha,
  have hb : b :=
    hab ha,
  let c' := c,
  have hc : c' :=
    hbc hb,
  exact hc
end

/-! ## Dependent Types

Dependent types are the defining feature of the dependent type theory family of
logics.

Consider a function `pick` that take a number `n : ℕ` and that returns a number
between 0 and `n`. Conceptually, `pick` has a dependent type, namely

    `(n : ℕ) → {i : ℕ // i ≤ n}`

We can think of this type as a `ℕ`-indexed family, where each member's type may
depend on the index:

    `pick n : {i : ℕ // n ≤ x}`

But a type may also depend on another type, e.g., `list` (or `λα, list α`) and
`λα, α → α`.

A term may depend on a type, e.g., `λα, λx : α, x` (a polymorphic identity
function).

Of course, a term may also depend on a term.

Unless otherwise specified, a __dependent type__ means a type depending on a
term. This is what we mean when we say that simple type theory does not support
dependent types.

In summary, there are four cases for `λx, t` in the calculus of inductive
constructions (cf. Barendregt's λ-cube):

Body (`t`) |              | Argument (`x`) | Description
---------- | ------------ | -------------- | ------------------------------
A term     | depending on | a term         | Simply typed λ-expression
A type     | depending on | a term         | Dependent type (stricto senso)
A term     | depending on | a type         | Polymorphic term
A type     | depending on | a type         | Type constructor

Revised typing rules:

    C ⊢ t : (x : σ) → τ[x]    C ⊢ u : σ
    ———————————————————————————————————— App'
    C ⊢ t u : τ[u]

    C, x : σ ⊢ t : τ[x]
    ———————————————————————————————— Lam'
    C ⊢ (λx : σ, t) : (x : σ) → τ[x]

These two rules degenerate to `App` and `Lam` if `x` does not occur in `τ[x]`

Example of `App'`:

    ⊢ pick : (x : ℕ) → {y : ℕ // y ≤ x}    ⊢ 5 : ℕ
    ——————————————————————————————————————————————— App'
    ⊢ pick 5 : {y : ℕ // y ≤ 5}

Example of `Lam'`:

    α : Type, x : α ⊢ x : α
    ——————————————————————————————— Lam or Lam'
    α : Type ⊢ (λx : α, x) : α → α
    ————————————————————————————————————————————— Lam'
    ⊢ (λα : Type, λx : α, x) : (α : Type) → α → α

Regrettably, the intuitive syntax `(x : σ) → τ` is not available in Lean.
Instead, we must write `∀x : σ, τ` to specify a dependent type.

Aliases:

    `σ → τ` := `∀_ : σ, τ`
    `Π`     := `∀`

## The Curry–Howard Correspondence

`→` is used both as the implication symbol and as the type constructor of
functions. Similarly, `∀` is used both as a quantifier and in dependent types.

The two pairs of concepts not only look the same, they are the same, by the PAT
principle:

* PAT = propositions as types;
* PAT = proofs as terms.

This is also called the Curry–Howard(–De Bruijn) correspondence.

Types:

* `σ → τ` is the type of total functions from `σ` to `τ`;
* `∀x : σ, τ[x]` is the dependent function type from `x : σ` to `τ[x]`.

Propositions:

* `P → Q` can be read as "`P` implies `Q`", or as the type of functions mapping
  proofs of `P` to proofs of `Q`.
* `∀x : σ, Q[x]` can be read as "for all `x`, `Q[x]`", or as the type of
  functions mapping values `x` of type `σ` to proofs of `Q[x]`.

Terms:

* A constant is a term.
* A variable is a term.
* `t u` is the application of function `t` to value `u`.
* `λx, t[x]` is a function mapping `x` to `t[x]`.

Proofs:

* A lemma or hypothesis name is a proof.
* `H t`, which instantiates the leading parameter or quantifier of proof `H`'
  statement with term `t`, is a proof.
* `H G`, which discharges the leading assumption of `H`'s statement with
  proof `G`, is a proof.
* `λh : P, H[h]` is a proof of `P → Q`, assuming `H[h]` is a proof of `Q`
  for `h : P`.
* `λx : σ, H[x]` is a proof of `∀x : σ, Q[x]`, assuming `H[x]` is a proof of
  `Q[x]` for `x : σ`. -/

lemma and_swap₃ (a b : Prop) :
  a ∧ b → b ∧ a :=
λ hab : a ∧ b, and.intro (and.elim_right hab) (and.elim_left hab)

lemma and_swap₄ (a b : Prop) :
  a ∧ b → b ∧ a :=
begin
  intro hab,
  apply and.intro,
  apply and.elim_right,
  exact hab,
  apply and.elim_left,
  exact hab
end

#check λ (Q R S : Type*) (v : R → S) (u : Q → R) (x : Q),
        v (u x)
/-! Tactical proofs are reduced to proof terms. -/

#print and_swap₃
#print and_swap₄

/-! ## Induction by Pattern Matching

By the Curry–Howard correspondence, a proof by induction is the same as a
recursively specified proof term. Thus, as alternative to the `induction`
tactic, induction can also be done by pattern matching:

 * the induction hypothesis is then available under the name of the lemma we are
   proving;

 * well-foundedness of the argument is often proved automatically. -/

#check reverse

lemma reverse_append {α : Type} :
  ∀xs ys : list α, reverse (xs ++ ys) = reverse ys ++ reverse xs
| []        ys := by simp [reverse]
| (x :: xs) ys := by simp [reverse, reverse_append xs]

lemma reverse_append₂ {α : Type} (xs ys : list α) :
  reverse (xs ++ ys) = reverse ys ++ reverse xs :=
begin
  induction xs,
  {
    simp [reverse],
  },
  {
    simp [reverse, xs_ih],
  }
end

lemma reverse_reverse {α : Type} :
  ∀xs : list α, reverse (reverse xs) = xs
| []        := by refl
| (x :: xs) :=
  by simp [reverse, reverse_append, reverse_reverse xs]

end LoVe


-- 4.1. The Universal Quantifier
-- Prove (∀ x : α, p x ∧ q x) → ∀ y : α, p y
namespace one
variables (α : Type) (p q : α → Prop) -- This defines α and 'p' and 'q' for the whole file

example : (∀ x : α, p x ∧ q x) → ∀ y : α, p y  :=
assume h : ∀ x : α, p x ∧ q x,
assume y : α,
show p y, from (h y).left

example : (∀ x : α, p x ∧ q x) → ∀ y : α, p y  :=
assume h : ∀ x : α, p x ∧ q x,
assume y : α,
show p y, from and.left (h y)

-- My example, using variable x in both the hypothesis and in the conclusion,
-- plus explicity set the quantifier in the 'show' section.
example : (∀ x : α, p x ∧ q x) → ∀ y : α, p y  :=
assume h : ∀ x : α, p x ∧ q x,
show ∀ y, p y, from
  (assume y: α, show p y, from (h y).left)

-- Remember that expressions which differ up to renaming of bound variables are considered to
-- be equivalent. So, for example, we could have used the same variable, x, in both the hypothesis
-- and conclusion, and instantiated it by a different variable, z, in the proof:
example : (∀ x : α, p x ∧ q x) → ∀ x : α, p x  :=
assume h : ∀ x : α, p x ∧ q x,
assume z : α,
show p z, from and.left (h z)
end one

-- Express the fact that a relation, r, is transitive:
namespace two
variable (α : Type)
variables (r : α → α → Prop)
variable  trans_r : ∀ x y z, r x y → r y z → r x z

variables a b c : α
variables (hab : r a b) (hbc : r b c)

#check trans_r    -- ∀ (x y z : α), r x y → r y z → r x z
#check trans_r a b c
#check trans_r a b c hab
#check trans_r a b c hab hbc
end two

namespace three
universe u
variables (α : Type u) (r : α → α → Prop)
variable  trans_r : ∀ {x y z}, r x y → r y z → r x z

variables (a b c : α)
variables (hab : r a b) (hbc : r b c)

#check trans_r
#check trans_r hab
#check trans_r hab hbc
end three

namespace four
variables (α : Type) (r : α → α → Prop)

variable refl_r : ∀ x, r x x
variable symm_r : ∀ {x y}, r x y → r y x
variable trans_r : ∀ {x y z}, r x y → r y z → r x z

example (a b c d : α) (hab : r a b) (hcb : r c b) (hcd : r c d) :
  r a d :=
trans_r (trans_r hab (symm_r hcb)) hcd
end four

-- 4.2. Equality
namespace equality_1
universe u
variables (α : Type u) (a b c d : α)
variables (hab : a = b) (hcb : c = b) (hcd : c = d)

example : a = d :=
eq.trans (eq.trans hab (eq.symm hcb)) hcd

-- We can also use the projection notation:
example : a = d := (hab.trans hcb.symm).trans hcd

end equality_1

namespace equality_2
universe u
variables (α β : Type u)

example (f : α → β) (a : α) : (λ x, f x) a = f a := eq.refl _
example (a : α) (b : α) : (a, b).1 = a := eq.refl _
example : 2 + 3 = 5 := eq.refl _

-- This feature of the framework is so important that the library defines a notation rfl
example (f : α → β) (a : α) : (λ x, f x) a = f a := rfl
example (a : α) (b : α) : (a, b).1 = a := rfl
example : 2 + 3 = 5 := rfl

end equality_2

namespace equality_3
-- Equality is much more than an equivalence relation, however. It has the important property that
-- every assertion respects the equivalence, in the sense that we can substitute equal expressions
-- without changing the truth value. That is, given h1 : a = b and h2 : p a, we can construct
-- a proof for p b using substitution: eq.subst h1 h2.
universe u

example (α : Type u) (a b : α) (p : α → Prop)
  (h1 : a = b) (h2 : p a) : p b :=
eq.subst h1 h2

example (α : Type u) (a b : α) (p : α → Prop)
  (h1 : a = b) (h2 : p a) : p b :=
h1 ▸ h2

end equality_3

namespace equality_4
variable α : Type
variables a b : α
variables f g : α → ℕ
variable h₁ : a = b
variable h₂ : f = g

example : f a = f b := congr_arg f h₁
example : f a = g a := congr_fun h₂ a
example : f a = g b := congr h₂ h₁
end equality_4

-- 4.4. The Existential Quantifier
example : ∃ x : ℕ, x > 0 :=
have h : 1 > 0, from nat.zero_lt_succ 0,
exists.intro 1 h

example : ∃ x : ℕ, x > 0 :=
have h : 4 > 0, from nat.zero_lt_succ 3,
exists.intro 4 h

example (x : ℕ) (h : x > 0) : ∃ y, y < x :=
exists.intro 0 h

example (x y z : ℕ) (hxy : x < y) (hyz : y < z) :
  ∃ w, x < w ∧ w < z :=
exists.intro y (and.intro hxy hyz)

#check @exists.intro

-- We can use the anonymous constructor notation ⟨t, h⟩ for exists.intro t h, when the
-- type is clear from the context.
example : ∃ x : ℕ, x > 0 :=
⟨1, nat.zero_lt_succ 0⟩

example (x : ℕ) (h : x > 0) : ∃ y, y < x :=
⟨0, h⟩

example (x y z : ℕ) (hxy : x < y) (hyz : y < z) :
  ∃ w, x < w ∧ w < z :=
⟨y, hxy, hyz⟩

-- Note that exists.intro has implicit arguments: Lean has to infer the predicate p : α → Prop
-- in the conclusion ∃ x, p x.
-- For example, if we have have hg : g 0 0 = 0 and write exists.intro 0 hg, there are many
-- possible values for the predicate p, corresponding to the theorems
-- ∃ x, g x x = x, ∃ x, g x x = 0, ∃ x, g x 0 = x, etc.
-- Lean uses the context to infer which one is appropriate.
variable g : ℕ → ℕ → ℕ
variable hg : g 0 0 = 0

theorem gex1 : ∃ x, g x x = x := ⟨0, hg⟩
theorem gex2 : ∃ x, g x 0 = x := ⟨0, hg⟩
theorem gex3 : ∃ x, g 0 0 = x := ⟨0, hg⟩
theorem gex4 : ∃ x, g x x = 0 := ⟨0, hg⟩

theorem gex5 : ∃ x, g 0 x = x := ⟨0, hg⟩
theorem gex6 : ∃ x, g x 0 = 0 := ⟨0, hg⟩
theorem gex7 : ∃ x, g 0 x = 0 := ⟨0, hg⟩

set_option pp.implicit true  -- display implicit arguments
#print gex1
#print gex2
#print gex3
#print gex4

-- The existential elimination rule, exists.elim, performs the opposite operation.
-- It allows us to prove a proposition q from ∃ x : α, p x, by showing that q follows from p w for an arbitrary value w.
-- Roughly speaking, since we know there is an x satisfying p x, we can give it a name, say, w.
-- If q does not mention w, then showing that q follows from p w is tantamount to showing the q follows from the existence of any such x. Here is an example:
namespace five
variables (α : Type) (p q : α → Prop)

example (h : ∃ x, p x ∧ q x) : ∃ x, q x ∧ p x :=
exists.elim h
  (assume w,
    assume hw : p w ∧ q w,
    show ∃ x, q x ∧ p x, from ⟨w, ⟨hw.right, hw.left⟩⟩)
end five

-- Lean provides a more convenient way to eliminate from an existential quantifier with the match statement:
namespace six
variables (α : Type) (p q : α → Prop)

example (h : ∃ x, p x ∧ q x) : ∃ x, q x ∧ p x :=
match h with ⟨w, hw⟩ :=
  ⟨w, hw.right, hw.left⟩
end

-- We can annotate the types used in the match for greater clarity:
example (h : ∃ x, p x ∧ q x) : ∃ x, q x ∧ p x :=
match h with ⟨(w : α), (hw : p w ∧ q w)⟩ :=
  ⟨w, hw.right, hw.left⟩
end

-- We can even use the match statement to decompose the conjunction at the same time:
example (h : ∃ x, p x ∧ q x) : ∃ x, q x ∧ p x :=
match h with ⟨w, hpw, hqw⟩ :=
  ⟨w, hqw, hpw⟩
end

-- Lean also provides a pattern-matching let expression:
example (h : ∃ x, p x ∧ q x) : ∃ x, q x ∧ p x :=
let ⟨w, hpw, hqw⟩ := h in ⟨w, hqw, hpw⟩

-- This is essentially just alternative notation for the match construct above. Lean will even allow
-- us to use an implicit match in the assume statement:
example : (∃ x, p x ∧ q x) → ∃ x, q x ∧ p x :=
assume ⟨w, hpw, hqw⟩, ⟨w, hqw, hpw⟩

end six

-- Prove ¬ ∀ x, ¬ p x → ∃ x, p x
namespace ApEp
variables (α : Type) (p : α → Prop)

example (h : ¬ ∀ x, ¬ p x) : ∃ x, p x :=
classical.by_contradiction
  (assume h1 : ¬ ∃ x, p x,
    have h2 : ∀ x, ¬ p x, from
      assume x,
      assume h3 : p x,
      have h4 : ∃ x, p x, from  ⟨x, h3⟩,
      show false, from h1 h4,
    show false, from h h2)

-- Same example using Exists.intro
example (h : ¬ ∀ x, ¬ p x) : ∃ x, p x :=
classical.by_contradiction
  (assume h1 : ¬ ∃ x, p x,
    have h2 : ∀ x, ¬ p x, from
      assume x,
      assume h3 : p x,
      have h4 : ∃ x, p x, from exists.intro x h3,
      show false, from h1 h4,
    show false, from h h2)
end ApEp

-- Existential quantifier. Exercises:
namespace exercises
open classical

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

example : (∃ x : α, r) → r :=
assume h : (∃ x : α, r),
exists.elim h
(assume (a : α) (hr : r), show r, from hr)

example : r → (∃ x : α, r) :=
assume h : r,
exists.intro a h

example : (∃ x, p x) ∧ r ↔ (∃ x, p x ∧ r) :=
iff.intro
(
 assume h : ((∃ x, p x) ∧ r), show (∃ x, p x ∧ r), from
 exists.elim (and.left h)
  (assume a (hr : p a), show (∃ x, p x ∧ r),
  from exists.intro a (and.intro hr (and.right h)))
)
(
 assume h : (∃ x, p x ∧ r), show (∃ x, p x) ∧ r, from
 and.intro
 (exists.elim h (assume a (hr : p a ∧ r), show (∃ x, p x), from exists.intro a hr.left))
 (exists.elim h (assume a (hr : p a ∧ r), show r, from and.right hr))
)

example : (∃ x, p x ∨ q x) ↔ (∃ x, p x) ∨ (∃ x, q x) :=
iff.intro
(assume h : (∃ x, p x ∨ q x), show (∃ x, p x) ∨ (∃ x, q x), from
  exists.elim h (assume a (hr : p a ∨ q a), show (∃ x, p x) ∨ (∃ x, q x),
  from or.elim hr
    (assume hpa : p a, show (∃ x, p x) ∨ (∃ x, q x), from or.inl (exists.intro a hpa))
    (assume hpq : q a, show (∃ x, p x) ∨ (∃ x, q x), from or.inr (exists.intro a hpq)))
)
(assume h : (∃ x, p x) ∨ (∃ x, q x), show (∃ x, p x ∨ q x), from
  or.elim h
  (assume hpq : (∃ x, p x), show (∃ x, p x ∨ q x), from
    exists.elim hpq
      (assume a (hpa : p a), show (∃ x, p x ∨ q x), from exists.intro a (or.inl hpa))
  )
  (assume hpq : (∃ x, q x), show (∃ x, p x ∨ q x), from
    exists.elim hpq
      (assume a (hpa : q a), show (∃ x, p x ∨ q x), from exists.intro a (or.inr hpa))
  )
)

end exercises

-- 4.5. More on the Proof Language
variable f : ℕ → ℕ
variable h : ∀ x : ℕ, f x ≤ f (x + 1)

example : f 0 ≥ f 1 → f 0 = f 1 :=
assume : f 0 ≥ f 1,
show f 0 = f 1, from le_antisymm (h 0) this

-- 4.6. Exercises
-- Prove these equivalences:
variables (α : Type) (p q : α → Prop)

example : (∀ x, p x ∧ q x) → (∀ x, p x) ∧ (∀ x, q x)  :=
assume h : (∀ x, p x ∧ q x),
show (∀ x, p x) ∧ (∀ x, q x), from
and.intro
  (assume x : α, show p x, from (h x).left)
  (assume x : α, show q x, from (h x).right)

example :  (∀ x, p x) ∧ (∀ x, q x) → (∀ x, p x ∧ q x) :=
assume h : (∀ x, p x) ∧ (∀ x, q x),
assume x : α,
show p x ∧ q x, from
and.intro (h.left x) (h.right x)

example : (∀ x, p x ∧ q x) ↔ (∀ x, p x) ∧ (∀ x, q x) :=
iff.intro
(assume h : (∀ x, p x ∧ q x),
  show (∀ x, p x) ∧ (∀ x, q x), from
    and.intro
    (assume x : α, show p x, from (h x).left)
    (assume x : α, show q x, from (h x).right))
(assume h : (∀ x, p x) ∧ (∀ x, q x),
  show (∀ x, p x ∧ q x), from
  (assume x : α,
   show p x ∧ q x, from and.intro (h.left x) (h.right x)))

example : (∀ x, p x → q x) → (∀ x, p x) → (∀ x, q x) :=
assume h : (∀ x, p x → q x),
assume i : (∀ x, p x),
show (∀ x, q x), from
(assume x : α, show q x, from (h x)(i x))

example : (∀ x, p x → q x) → (∀ x, p x) → (∀ x, q x) :=
assume h : (∀ x, p x → q x),
assume i : (∀ x, p x),
show (∀ x, q x), from
(assume a : α, show q a, from (h a)(i a))

example : (∀ x, p x) ∨ (∀ x, q x) → ∀ x, p x ∨ q x :=
assume h : (∀ x, p x) ∨ (∀ x, q x),
show ∀ x, p x ∨ q x, from
assume a : α, show p a ∨ q a, from
or.elim h
(assume h1 : (∀ x, p x), show p a ∨ q a, from or.inl (h1 a))
(assume h2 : (∀ x, q x), show p a ∨ q a, from or.inr (h2 a))


import tactic
open classical

section

parameters {A : Type} {R : A → A → Prop}

/- Defininig Complete Relations -/
def complete (R : A → A → Prop) : Prop :=
∀ x y, R x y ∨ R y x

/- Defininig Incomplete Relations -/
def incomplete (R : A → A → Prop) : Prop :=
∃ x y, ¬ (R x y ∨ R y x)

/- Defininig S the Strict Preference Relation-/
def S (a b : A) : Prop := R a b ∧ ¬ R b a

/- Defininig the Indifference Relation-/
def I (a b : A) : Prop := R a b ∧ R b a

/-Prop 1.9 https://assets.press.princeton.edu/chapters/s9890.pdf-/

/- 1.9 a -/
theorem propa (compR : complete R) (x : A)(y : A): S x y ↔ ¬ R y x :=
begin
split,
{intro Sxy, cases Sxy, assumption,},
{intro nRyx, rw [S], have RxyOrRyx : R x y ∨ R y x, from compR x y, tauto,}

end

/- 1.9 b -/
theorem propb (compR : complete R) (trnsR : transitive R)(x : A)(y : A): S x y → ¬ S y x :=
begin
intros Sxy nSyx, rw [S] at *, tauto,
end

/- 1.9 d -/
theorem propd (compR : complete R) (trnsR : transitive R)(x : A): I x x :=
begin
have Rxx : R x x ∨ R x x, from compR x x, rw [I], tauto,
end

/- 1.9 e -/
theorem prope (compR : complete R) (trnsR : transitive R)(x : A)(y : A): I x y → I y x :=
begin
intro Ixy, cases Ixy, rw [I], tauto,
end

/- 1.9 f -/
theorem propf (compR : complete R) (trnsR : transitive R)(x : A)(y : A)(z : A):
(I x y ∧ I y z) → I x z :=
begin
intro IxyandIyz, cases IxyandIyz, rename [IxyandIyz_left Ixy, IxyandIyz_right Iyz], cases Ixy, cases Iyz, rw [I], tauto,
end

/- 1.9 g -/
theorem propg (compR : complete R) (trnsR : transitive R)(x : A)(y : A)(z : A): (S x y ∧ R y z) → S x z :=
begin
intro SxyandRyz, cases SxyandRyz, rename [SxyandRyz_left Sxy, SxyandRyz_right Ryz], cases Sxy, rw [S], split,
{rename [Sxy_left Rxy, Sxy_right nRyx], exact trnsR Rxy Ryz,},
{rename[Sxy_left Rxy, Sxy_right nRyx], by_contra Rzx, have Ryx : R y x, from trnsR Ryz Rzx, tauto,}
end

/- 1.9 h -/
theorem proph (compR : complete R) (trnsR : transitive R)(x : A)(y : A)(z : A): (S x y ∧ S y z) → S x z :=
begin
intro SxyandSyx, cases SxyandSyx, rename[SxyandSyx_left Sxy, SxyandSyx_right Syz], rw [S] at Syz, cases Syz,
rename[Syz_left Ryz, Syz_right nRzy], exact propg compR trnsR x y z (and.intro Sxy Ryz),
end

/- 1.9 c -/
theorem propc (compR : complete R) (trnsR : transitive R)(x : A)(y : A)(z : A): S x y → (S z y ∨ S x z) :=
begin
intro Sxy, have h1 : R y z ∨ R z y, from compR y z, have h2 : R x z ∨ R z x, from compR x z, cases Sxy, cases h1, cases h2,
{rename [Sxy_left Rxy, Sxy_right nRyx, h1 Ryz, h2 Rxz],
have Sxy : S x y, from and.intro Rxy nRyx,
have Sxz : S x z, from propg compR trnsR x y z (and.intro Sxy Ryz),
apply or.inr,
assumption,
},
{rename [Sxy_left Rxy, Sxy_right nRyx, h1 Ryz, h2 Rzx],
have Sxy : S x y, from and.intro Rxy nRyx,
have Sxz : S x z, from propg compR trnsR x y z (and.intro Sxy Ryz),
apply or.inr,
assumption,
},
{
cases h2,
{rename [Sxy_left Rxy, Sxy_right nRyx, h1 Rzy, h2 Rxz],
have Sxy : S x y, from and.intro Rxy nRyx,
by_contra' h,
cases h,
rename [h_left nSzy, h_right nSxz],
rw S at nSzy,
push_neg at nSzy,
rename nSzy h,
have Ryz : R y z, from h Rzy,
have Sxz : S x z, from propg compR trnsR x y z (and.intro Sxy Ryz),
trivial,
},
{rename [Sxy_left Rxy, Sxy_right nRyx, h1 Rzy, h2 Rzx],
have Sxy : S x y, from and.intro Rxy nRyx,
by_contra' h,
cases h,
rename [h_left nSzy, h_right nSxz],
rw S at nSzy,
push_neg at nSzy,
rename nSzy h,
have Ryz : R y z, from h Rzy,
have Sxz : S x z, from propg compR trnsR x y z (and.intro Sxy Ryz),
trivial,
},
}

end

end


/-
Copyright (c) 2020 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin, Kenny Lau
-/

import algebra.geom_sum
import ring_theory.ideal.quotient

/-!
# Basic results in number theory

This file should contain basic results in number theory. So far, it only contains the essential
lemma in the construction of the ring of Witt vectors.

## Main statement

`dvd_sub_pow_of_dvd_sub` proves that for elements `a` and `b` in a commutative ring `R` and for
all natural numbers `p` and `k` if `p` divides `a-b` in `R`, then `p ^ (k + 1)` divides
`a ^ (p ^ k) - b ^ (p ^ k)`.
-/

section

open ideal ideal.quotient

lemma dvd_sub_pow_of_dvd_sub {R : Type*} [comm_ring R] {p : ℕ}
  {a b : R} (h : (p : R) ∣ a - b) (k : ℕ) :
  (p^(k+1) : R) ∣ a^(p^k) - b^(p^k) :=
begin
  induction k with k ih,
  { rwa [pow_one, pow_zero, pow_one, pow_one] },
  rw [pow_succ' p k, pow_mul, pow_mul, ← geom_sum₂_mul, pow_succ],
  refine mul_dvd_mul _ ih,
  let I : ideal R := span {p},
  let f : R →+* R ⧸ I := mk I,
  have hp : (p : R ⧸ I) = 0,
  { rw [← map_nat_cast f, eq_zero_iff_mem, mem_span_singleton] },
  rw [← mem_span_singleton, ← ideal.quotient.eq] at h,
  rw [← mem_span_singleton, ← eq_zero_iff_mem, ring_hom.map_geom_sum₂,
      ring_hom.map_pow, ring_hom.map_pow, h, geom_sum₂_self, hp, zero_mul],
end

end


variable n : ℕ

lemma zero_add1 : 0 + n = n :=
begin
    induction n with d hd,
    rw add_zero,

    rw nat.add_succ,
    rw hd,
end


import measure_theory.lebesgue_measure
import measure_theory.measurable_space

open measure_theory

-- https://en.wikipedia.org/wiki/Probability_space

class probability_space (α : Type*) extends measure_space α :=
(is_probability_measure:  probability_measure volume)

-- https://en.wikipedia.org/wiki/Random_variable#Definition

def random_variable (α β: Type*) (PS: probability_space α) (MS: measurable_space β):=
  @measurable α β PS.to_measure_space.to_measurable_space MS

--https://en.wikipedia.org/wiki/Stochastic_process#Stochastic_process

def stochastic_process (α β T: Type*) (PS: probability_space α) (MS: measurable_space β) (X: T → α → β) (t: T) :=
  random_variable α β PS MS (X t)

-- https://en.wikipedia.org/wiki/Stochastic_process#Index_set

def index_set (α β T: Type*) (X: T → α → β) := T

-- https://en.wikipedia.org/wiki/Stochastic_process#State_space

def state_space (α β T: Type*) (X: T → α → β) := β

-- https://en.wikipedia.org/wiki/Stochastic_process#Sample_function

def sample_function (α β T: Type*) (X: T → α → β) := λ (ω: α), λ (t: T), X t ω

-- https://en.wikipedia.org/wiki/Stochastic_process#Law
def law (α β T: Type*)
        (PS: probability_space α)
        (MS: measurable_space β)
        (X: T → α → β)
        (t: T)
        (SP: stochastic_process α β T PS MS X t)
        (HM: has_mem β β)
        (Y: set β):=
  PS.volume.to_outer_measure.measure_of {ω : α | ∃ y:β, X t ω ∈ y}

-- Steinhaus space

noncomputable instance {α} {p : α → Prop} [m : measure_space α] : measure_space (subtype p) :=
{ volume := measure.comap (coe : _ → α) volume }

theorem subtype.volume_apply {α} {p : α → Prop} [measure_space α]
  (hp : is_measurable {x | p x}) {s : set (subtype p)} (hs : is_measurable s) :
  volume s = volume ((coe : _ → α) '' s) :=
measure.comap_apply _ subtype.coe_injective (λ _, is_measurable.subtype_image hp) _ hs

instance steinhaus_measure : probability_measure (volume : measure (set.Icc (0 : ℝ) 1)) :=
{ measure_univ := begin
    refine (subtype.volume_apply is_measurable_Icc is_measurable.univ).trans _,
    suffices : volume (set.Icc (0 : ℝ) 1) = 1, {simpa},
    rw [real.volume_Icc], simp
  end
}

noncomputable instance steinhaus_space : probability_space (set.Icc (0 : ℝ) 1) :=
{ is_probability_measure := steinhaus_measure }


/-
The cases tactic applies the elimination
rules to a term, appropriate to it's type.

For example, if h is a proof of P ∧ Q, the
cases tactic will "eliminate" h to a proof
of p and proof of q; and that will be the
only case. Why? Because there's only one
way that the proof, h, could have been
constructed, namely by the application of
and.intro to two arguments, a proof of P
and a proof of Q.
-/

variables P Q R : Prop

/-
You *could* apply the elimination rules
"manually."
-/
example : P ∧ Q → P :=
begin
assume h,
let p : P := and.elim_left h,
exact p,
end

/-
Or you could just use the cases tactic
-/
example : P ∧ Q → P :=
begin
assume h,
cases h,
exact h_left,
end

/-
If you don't specify names for the
results of the elimination, Lean will
make up names for you. It's better to
provide more meaningful names. It can
make a big difference in being able
to think about what you've got.
-/
example : P ∧ Q → P :=
begin
assume h,
cases h with p q, -- *with p q*
exact p,
end

/-
Now suppose you've got a proof of a type
for which there are two introduction rules.
There are now *two ways* that an assumed
proof could have been constructed. What you
generally want to know is that no matter
how the proof was constructive, the goal
remains true. To prove that, you need to
consider each *case*.

Consider a proof of P ∨ Q. There are two
introduction rules: or.intro_left Q p and
or.intro_right P q. Note that if Lean is
able to infer the P and Q arguments, you
can use the simpler or.inl p and or.inr q
constructors.
-/

example : P ∨ Q → (P → R) → (Q → R) → R :=
begin
assume h,
cases h with p q,
/-
What remain are two subgoals, one
for each case. If the proof, h, of
P ∨ Q was constructed using or.inl,
then you need to show that given P,
R follows (basically P → R); and if
P ∨ Q was proven using or.inr q, you
need to complete the proof of Q → R.
(Given the assumed proof of Q, show
that R is true by provind a proof of
it.)
-/
end

/-
If we want to reason "classically"
rather than constructively, then we
can use the classical.em rule to
convert and proposition, P, into a
proof of P ∨ ¬P, *on which we can
then do case analysis*.
-/

#check @classical.em P

example : ¬¬P → P :=
begin
assume nnp,
cases (classical.em P) with p np, -- here!
-- make sure you can finish this proof!
exact p,
contradiction,
end

/-
How is a proof of P ↔ Q constructed? It's by
applying iff.intro to a proof of P → Q and to
a proof of Q → P. That's the only way to do
it. When we apply case analysis to a proof of
P ↔ Q we should thus expect one case, where
iff.intro was applied to two assumed argments
of the right types. That's just what we get.
-/

example : (P ↔ Q) → (Q → P) :=
begin
assume h,
cases h with pq qp,
assumption, -- uses proof in context
end

/-
As an aside, we can even do case analysis
on data values. The bool type, for example,
has two values.
-/

def my_not : bool → bool :=
begin
assume b,
cases b,
exact tt, -- in case b = tt, return ff
exact ff, -- in case b = ff, return tt
end

#eval (my_not tt)
#eval (my_not ff)

-- Whoa: we defined a function by cases!

/-
Finally, case analysis works only on data
values, including proof values. It can't
be applied to functions. In the following
example, we assume we have a function that
takes a nat and returns a nat, along with
a nat. We'll first show how you can "prove
this type" by giving a particular function
value of this type; then we'll get to the
main point, which is to show that you will
get an error if you try to do case analysis
on the function argument.
-/

def app_func : (ℕ → ℕ) → ℕ → ℕ :=
begin
assume f n,
exact (f n),
end

#eval

/-
What you have just proved is that if
f takes and returns a nat, and n is
a nat, then f applied to n is a nat.
What happens if we try "cases f"? It's
a no-go.
-/

example : (ℕ → ℕ) → ℕ → ℕ :=
begin
assume f n,
cases f,
/-
Error: "cases tactic failed, it is not
applicable to the given hypothesis." You
can't do case analysis on a function, or
on a proof of an implication or universal
generalization, because these things are
basically functions.
-/

example : (P → Q) → P → Q :=
begin
assume i p,
exact (i p),
end

example : (P → Q) → P → Q :=
begin
assume i p,
cases i,      -- Nope
end

/-
Similarly you can't do case analysis
on a data *type* (such as bool) or on
a proposition (a logical *type*). These
things aren't data values, so "cases"
does not work. Independent of Lean,
you can't do "case analysis" on things
of these kind in predicate logic.
-/


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

import group_theory.general_commutator
import group_theory.quotient_group

/-!

# Nilpotent groups

An API for nilpotent groups, that is, groups for which the upper central series
reaches `⊤`.

## Main definitions

Recall that if `H K : subgroup G` then `⁅H, K⁆ : subgroup G` is the subgroup of `G` generated
by the commutators `hkh⁻¹k⁻¹`. Recall also Lean's conventions that `⊤` denotes the
subgroup `G` of `G`, and `⊥` denotes the trivial subgroup `{1}`.

* `upper_central_series G : ℕ → subgroup G` : the upper central series of a group `G`.
     This is an increasing sequence of normal subgroups `H n` of `G` with `H 0 = ⊥` and
     `H (n + 1) / H n` is the centre of `G / H n`.
* `lower_central_series G : ℕ → subgroup G` : the lower central series of a group `G`.
     This is a decreasing sequence of normal subgroups `H n` of `G` with `H 0 = ⊤` and
     `H (n + 1) = ⁅H n, G⁆`.
* `is_nilpotent` : A group G is nilpotent if its upper central series reaches `⊤`, or
    equivalently if its lower central series reaches `⊥`.
* `nilpotency_class` : the length of the upper central series of a nilpotent group.
* `is_ascending_central_series (H : ℕ → subgroup G) : Prop` and
* `is_descending_central_series (H : ℕ → subgroup G) : Prop` : Note that in the literature
    a "central series" for a group is usually defined to be a *finite* sequence of normal subgroups
    `H 0`, `H 1`, ..., starting at `⊤`, finishing at `⊥`, and with each `H n / H (n + 1)`
    central in `G / H (n + 1)`. In this formalisation it is convenient to have two weaker predicates
    on an infinite sequence of subgroups `H n` of `G`: we say a sequence is a *descending central
    series* if it starts at `G` and `⁅H n, ⊤⁆ ⊆ H (n + 1)` for all `n`. Note that this series
    may not terminate at `⊥`, and the `H i` need not be normal. Similarly a sequence is an
    *ascending central series* if `H 0 = ⊥` and `⁅H (n + 1), ⊤⁆ ⊆ H n` for all `n`, again with no
    requirement that the series reaches `⊤` or that the `H i` are normal.

## Main theorems

`G` is *defined* to be nilpotent if the upper central series reaches `⊤`.
* `nilpotent_iff_finite_ascending_central_series` : `G` is nilpotent iff some ascending central
    series reaches `⊤`.
* `nilpotent_iff_finite_descending_central_series` : `G` is nilpotent iff some descending central
    series reaches `⊥`.
* `nilpotent_iff_lower` : `G` is nilpotent iff the lower central series reaches `⊥`.

## Warning

A "central series" is usually defined to be a finite sequence of normal subgroups going
from `⊥` to `⊤` with the property that each subquotient is contained within the centre of
the associated quotient of `G`. This means that if `G` is not nilpotent, then
none of what we have called `upper_central_series G`, `lower_central_series G` or
the sequences satisfying `is_ascending_central_series` or `is_descending_central_series`
are actually central series. Note that the fact that the upper and lower central series
are not central series if `G` is not nilpotent is a standard abuse of notation.

-/

open subgroup

variables {G : Type*} [group G] (H : subgroup G) [normal H]

/-- If `H` is a normal subgroup of `G`, then the set `{x : G | ∀ y : G, x*y*x⁻¹*y⁻¹ ∈ H}`
is a subgroup of `G` (because it is the preimage in `G` of the centre of the
quotient group `G/H`.)
-/
def upper_central_series_step : subgroup G :=
{ carrier := {x : G | ∀ y : G, x * y * x⁻¹ * y⁻¹ ∈ H},
  one_mem' := λ y, by simp [subgroup.one_mem],
  mul_mem' := λ a b ha hb y, begin
    convert subgroup.mul_mem _ (ha (b * y * b⁻¹)) (hb y) using 1,
    group,
  end,
  inv_mem' := λ x hx y, begin
    specialize hx y⁻¹,
    rw [mul_assoc, inv_inv] at ⊢ hx,
    exact subgroup.normal.mem_comm infer_instance hx,
  end }

lemma mem_upper_central_series_step (x : G) :
  x ∈ upper_central_series_step H ↔ ∀ y, x * y * x⁻¹ * y⁻¹ ∈ H := iff.rfl

open quotient_group

/-- The proof that `upper_central_series_step H` is the preimage of the centre of `G/H` under
the canonical surjection. -/
lemma upper_central_series_step_eq_comap_center :
  upper_central_series_step H = subgroup.comap (mk' H) (center (G ⧸ H)) :=
begin
  ext,
  rw [mem_comap, mem_center_iff, forall_coe],
  apply forall_congr,
  intro y,
  change x * y * x⁻¹ * y⁻¹ ∈ H ↔ ((y * x : G) : G ⧸ H) = (x * y : G),
  rw [eq_comm, eq_iff_div_mem, div_eq_mul_inv],
  congr' 2,
  group,
end

instance : normal (upper_central_series_step H) :=
begin
  rw upper_central_series_step_eq_comap_center,
  apply_instance,
end

variable (G)

/-- An auxiliary type-theoretic definition defining both the upper central series of
a group, and a proof that it is normal, all in one go. -/
def upper_central_series_aux : ℕ → Σ' (H : subgroup G), normal H
| 0 := ⟨⊥, infer_instance⟩
| (n + 1) := let un := upper_central_series_aux n, un_normal := un.2 in
   by exactI ⟨upper_central_series_step un.1, infer_instance⟩

/-- `upper_central_series G n` is the `n`th term in the upper central series of `G`. -/
def upper_central_series (n : ℕ) : subgroup G := (upper_central_series_aux G n).1

instance (n : ℕ) : normal (upper_central_series G n) := (upper_central_series_aux G n).2

@[simp] lemma upper_central_series_zero : upper_central_series G 0 = ⊥ := rfl

/-- The `n+1`st term of the upper central series `H i` has underlying set equal to the `x` such
that `⁅x,G⁆ ⊆ H n`-/
lemma mem_upper_central_series_succ_iff (n : ℕ) (x : G) :
  x ∈ upper_central_series G (n + 1) ↔
  ∀ y : G, x * y * x⁻¹ * y⁻¹ ∈ upper_central_series G n := iff.rfl

-- is_nilpotent is already defined in the root namespace (for elements of rings).
/-- A group `G` is nilpotent if its upper central series is eventually `G`. -/
class group.is_nilpotent (G : Type*) [group G] : Prop :=
(nilpotent [] : ∃ n : ℕ, upper_central_series G n = ⊤)

open group

section classical

open_locale classical

/-- The nilpotency class of a nilpotent group is the small natural `n` such that
the `n`'th term of the upper central series is `G`. -/
noncomputable def group.nilpotency_class (G : Type*) [group G] [is_nilpotent G] : ℕ :=
nat.find (is_nilpotent.nilpotent G)

end classical

variable {G}

/-- A sequence of subgroups of `G` is an ascending central series if `H 0` is trivial and
  `⁅H (n + 1), G⁆ ⊆ H n` for all `n`. Note that we do not require that `H n = G` for some `n`. -/
def is_ascending_central_series (H : ℕ → subgroup G) : Prop :=
  H 0 = ⊥ ∧ ∀ (x : G) (n : ℕ), x ∈ H (n + 1) → ∀ g, x * g * x⁻¹ * g⁻¹ ∈ H n

/-- A sequence of subgroups of `G` is a descending central series if `H 0` is `G` and
  `⁅H n, G⁆ ⊆ H (n + 1)` for all `n`. Note that we do not requre that `H n = {1}` for some `n`. -/
def is_descending_central_series (H : ℕ → subgroup G) := H 0 = ⊤ ∧
  ∀ (x : G) (n : ℕ), x ∈ H n → ∀ g, x * g * x⁻¹ * g⁻¹ ∈ H (n + 1)

/-- Any ascending central series for a group is bounded above by the upper central series. -/
lemma ascending_central_series_le_upper (H : ℕ → subgroup G) (hH : is_ascending_central_series H) :
  ∀ n : ℕ, H n ≤ upper_central_series G n
| 0 := hH.1.symm ▸ le_refl ⊥
| (n + 1) := begin
  specialize ascending_central_series_le_upper n,
  intros x hx,
  have := hH.2 x n hx,
  rw mem_upper_central_series_succ_iff,
  intro y,
  apply ascending_central_series_le_upper,
  apply this,
end

variable (G)

/-- The upper central series of a group is an ascending central series. -/
lemma upper_central_series_is_ascending_central_series :
  is_ascending_central_series (upper_central_series G) :=
⟨rfl, λ x n h, h⟩

lemma upper_central_series_mono : monotone (upper_central_series G) :=
begin
  refine monotone_nat_of_le_succ _,
  intros n x hx y,
  rw [mul_assoc, mul_assoc, ← mul_assoc y x⁻¹ y⁻¹],
  exact mul_mem (upper_central_series G n) hx
    (normal.conj_mem (upper_central_series.subgroup.normal G n) x⁻¹ (inv_mem _ hx) y),
end

/-- A group `G` is nilpotent iff there exists an ascending central series which reaches `G` in
  finitely many steps. -/
theorem nilpotent_iff_finite_ascending_central_series :
  is_nilpotent G ↔ ∃ H : ℕ → subgroup G, is_ascending_central_series H ∧ ∃ n : ℕ, H n = ⊤ :=
begin
  split,
  { intro h,
    use upper_central_series G,
    refine ⟨upper_central_series_is_ascending_central_series G, h.1⟩ },
  { rintro ⟨H, hH, n, hn⟩,
    use n,
    have := ascending_central_series_le_upper H hH n,
    rw hn at this,
    exact eq_top_iff.mpr this }
end

/-- A group `G` is nilpotent iff there exists a descending central series which reaches the
  trivial group in a finite time. -/
theorem nilpotent_iff_finite_descending_central_series :
  is_nilpotent G ↔ ∃ H : ℕ → subgroup G, is_descending_central_series H ∧ ∃ n : ℕ, H n = ⊥ :=
begin
  rw nilpotent_iff_finite_ascending_central_series,
  split,
  { rintro ⟨H, ⟨h0, hH⟩, n, hn⟩,
    use (λ m, H (n - m)),
    split,
    { refine ⟨hn, λ x m hx g, _⟩,
      dsimp at hx,
      by_cases hm : n ≤ m,
      { have hnm : n - m = 0 := tsub_eq_zero_iff_le.mpr hm,
        rw [hnm, h0, subgroup.mem_bot] at hx,
        subst hx,
        convert subgroup.one_mem _,
        group },
      { push_neg at hm,
        apply hH,
        convert hx,
        rw nat.sub_succ,
        exact nat.succ_pred_eq_of_pos (tsub_pos_of_lt hm) } },
    { use n,
      rwa tsub_self } },
  { rintro ⟨H, ⟨h0, hH⟩, n, hn⟩,
    use (λ m, H (n - m)),
    split,
    { refine ⟨hn, λ x m hx g, _⟩,
      dsimp only at hx,
      by_cases hm : n ≤ m,
      { have hnm : n - m = 0 := tsub_eq_zero_iff_le.mpr hm,
        dsimp only,
        rw [hnm, h0],
        exact mem_top _ },
      { push_neg at hm,
        dsimp only,
        convert hH x _ hx g,
        rw nat.sub_succ,
        exact (nat.succ_pred_eq_of_pos (tsub_pos_of_lt hm)).symm } },
    { use n,
      rwa tsub_self } },
end

/-- The lower central series of a group `G` is a sequence `H n` of subgroups of `G`, defined
  by `H 0` is all of `G` and for `n≥1`, `H (n + 1) = ⁅H n, G⁆` -/
def lower_central_series (G : Type*) [group G] : ℕ → subgroup G
| 0 := ⊤
| (n+1) := ⁅lower_central_series n, ⊤⁆

variable {G}

@[simp] lemma lower_central_series_zero : lower_central_series G 0 = ⊤ := rfl

lemma mem_lower_central_series_succ_iff (n : ℕ) (q : G) :
  q ∈ lower_central_series G (n + 1) ↔
  q ∈ closure {x | ∃ (p ∈ lower_central_series G n) (q ∈ (⊤ : subgroup G)), p * q * p⁻¹ * q⁻¹ = x}
:= iff.rfl

lemma lower_central_series_succ (n : ℕ) :
  lower_central_series G (n + 1) =
  closure {x | ∃ (p ∈ lower_central_series G n) (q ∈ (⊤ : subgroup G)), p * q * p⁻¹ * q⁻¹ = x} :=
rfl

instance (n : ℕ) : normal (lower_central_series G n) :=
begin
  induction n with d hd,
  { exact (⊤ : subgroup G).normal_of_characteristic },
  { exactI general_commutator_normal (lower_central_series G d) ⊤ },
end

lemma lower_central_series_antitone :
  antitone (lower_central_series G) :=
begin
  refine antitone_nat_of_succ_le (λ n x hx, _),
  simp only [mem_lower_central_series_succ_iff, exists_prop, mem_top, exists_true_left, true_and]
    at hx,
  refine closure_induction hx _ (subgroup.one_mem _) (@subgroup.mul_mem _ _ _)
    (@subgroup.inv_mem _ _ _),
  rintros y ⟨z, hz, a, ha⟩,
  rw [← ha, mul_assoc, mul_assoc, ← mul_assoc a z⁻¹ a⁻¹],
  exact mul_mem (lower_central_series G n) hz
    (normal.conj_mem (lower_central_series.subgroup.normal n) z⁻¹ (inv_mem _ hz) a),
end

/-- The lower central series of a group is a descending central series. -/
theorem lower_central_series_is_descending_central_series :
  is_descending_central_series (lower_central_series G) :=
begin
  split, refl,
  intros x n hxn g,
  exact general_commutator_containment _ _ hxn (subgroup.mem_top g),
end

/-- Any descending central series for a group is bounded below by the lower central series. -/
lemma descending_central_series_ge_lower (H : ℕ → subgroup G)
  (hH : is_descending_central_series H) : ∀ n : ℕ, lower_central_series G n ≤ H n
| 0 := hH.1.symm ▸ le_refl ⊤
| (n + 1) := begin
  specialize descending_central_series_ge_lower n,
  apply (general_commutator_le _ _ _).2,
  intros x hx q _,
  exact hH.2 x n (descending_central_series_ge_lower hx) q,
end

/-- A group is nilpotent if and only if its lower central series eventually reaches
  the trivial subgroup. -/
theorem nilpotent_iff_lower_central_series : is_nilpotent G ↔ ∃ n, lower_central_series G n = ⊥ :=
begin
  rw nilpotent_iff_finite_descending_central_series,
  split,
  { rintro ⟨H, ⟨h0, hs⟩, n, hn⟩,
    use n,
    have := descending_central_series_ge_lower H ⟨h0, hs⟩ n,
    rw hn at this,
    exact eq_bot_iff.mpr this },
  { intro h,
    use [lower_central_series G, lower_central_series_is_descending_central_series, h] },
end

lemma lower_central_series_map_subtype_le (H : subgroup G) (n : ℕ) :
  (lower_central_series H n).map H.subtype ≤ lower_central_series G n :=
begin
  induction n with d hd,
  { simp },
  { rw [lower_central_series_succ, lower_central_series_succ, monoid_hom.map_closure],
    apply subgroup.closure_mono,
    rintros x1 ⟨x2, ⟨x3, hx3, x4, hx4, rfl⟩, rfl⟩,
    exact ⟨x3, (hd (mem_map.mpr ⟨x3, hx3, rfl⟩)), x4, by simp⟩ }
end

instance subgroup.is_nilpotent (H : subgroup G) [hG : is_nilpotent G] :
  is_nilpotent H :=
begin
  rw nilpotent_iff_lower_central_series at *,
  rcases hG with ⟨n, hG⟩,
  use n,
  have := lower_central_series_map_subtype_le H n,
  simp only [hG, set_like.le_def, mem_map, forall_apply_eq_imp_iff₂, exists_imp_distrib] at this,
  exact eq_bot_iff.mpr (λ x hx, subtype.ext (this x hx)),
end

@[priority 100]
instance is_nilpotent_of_subsingleton [subsingleton G] : is_nilpotent G :=
nilpotent_iff_lower_central_series.2 ⟨0, subsingleton.elim ⊤ ⊥⟩

lemma upper_central_series.map {H : Type*} [group H] {f : G →* H} (h : function.surjective f)
  (n : ℕ) : subgroup.map f (upper_central_series G n) ≤ upper_central_series H n :=
begin
  induction n with d hd,
  { simp },
  { rintros _ ⟨x, hx : x ∈ upper_central_series G d.succ, rfl⟩ y',
    rcases (h y') with ⟨y, rfl⟩,
    simpa using hd (mem_map_of_mem f (hx y)) }
end

lemma lower_central_series.map {H : Type*} [group H] (f : G →* H) (n : ℕ) :
  subgroup.map f (lower_central_series G n) ≤ lower_central_series H n :=
begin
  induction n with d hd,
  { simp [nat.nat_zero_eq_zero] },
  { rintros a ⟨x, hx : x ∈ lower_central_series G d.succ, rfl⟩,
    refine closure_induction hx _ (by simp [f.map_one, subgroup.one_mem _])
      (λ y z hy hz, by simp [monoid_hom.map_mul, subgroup.mul_mem _ hy hz])
      (λ y hy, by simp [f.map_inv, subgroup.inv_mem _ hy]),
    rintros a ⟨y, hy, z, ⟨-, rfl⟩⟩,
    apply mem_closure.mpr,
    exact λ K hK, hK ⟨f y, hd (mem_map_of_mem f hy), by simp⟩ }
end

lemma lower_central_series_succ_eq_bot {n : ℕ} (h : lower_central_series G n ≤ center G) :
  lower_central_series G (n + 1) = ⊥ :=
begin
  rw [lower_central_series_succ, closure_eq_bot_iff, set.subset_singleton_iff],
  rintro x ⟨y, hy1, z, ⟨⟩, rfl⟩,
  symmetry,
  rw [eq_mul_inv_iff_mul_eq, eq_mul_inv_iff_mul_eq, one_mul],
  exact mem_center_iff.mp (h hy1) z,
end

lemma is_nilpotent_of_ker_le_center {H : Type*} [group H] {f : G →* H}
  (hf1 : f.ker ≤ center G) (hH : is_nilpotent H) : is_nilpotent G :=
begin
  rw nilpotent_iff_lower_central_series at *,
  rcases hH with ⟨n, hn⟩,
  refine ⟨n + 1, lower_central_series_succ_eq_bot
    (le_trans ((map_eq_bot_iff _).mp _) hf1)⟩,
  exact eq_bot_iff.mpr (hn ▸ (lower_central_series.map f n)),
end


import ..lovelib

/-! # LoVe Exercise 3: Forward Proofs -/

set_option pp.beta true
set_option pp.generalized_field_notation false

namespace LoVe

/-! ## Question 1: Connectives and Quantifiers

1.1. Supply structured proofs of the following lemmas. -/

lemma I (a : Prop) :
  a → a :=
sorry

lemma K (a b : Prop) :
  a → b → b :=
sorry

lemma C (a b c : Prop) :
  (a → b → c) → b → a → c :=
sorry

lemma proj_1st (a : Prop) :
  a → a → a :=
sorry

/-! Please give a different answer than for `proj_1st`. -/

lemma proj_2nd (a : Prop) :
  a → a → a :=
sorry

lemma some_nonsense (a b c : Prop) :
  (a → b → c) → a → (a → c) → b → c :=
sorry

/-! 1.2. Supply a structured proof of the contraposition rule. -/

lemma contrapositive (a b : Prop) :
  (a → b) → ¬ b → ¬ a :=
sorry

/-! 1.3. Supply a structured proof of the distributivity of `∀` over `∧`. -/

lemma forall_and {α : Type} (p q : α → Prop) :
  (∀x, p x ∧ q x) ↔ (∀x, p x) ∧ (∀x, q x) :=
sorry

/-! 1.4 (**optional**). Reuse, if possible, the lemma `forall_and` from question
1.3 to prove the following instance of the lemma. -/

lemma forall_and_inst {α : Type} (r s : α → α → Prop) :
  (∀x, r x x ∧ s x x) ↔ (∀x, r x x) ∧ (∀x, s x x) :=
sorry

/-! 1.5. Supply a structured proof of the following property, which can be used
to pull a `∀`-quantifier past an `∃`-quantifier. -/

lemma forall_exists_of_exists_forall {α : Type} (p : α → α → Prop) :
  (∃x, ∀y, p x y) → (∀y, ∃x, p x y) :=
sorry

/-! ## Question 2: Chain of Equalities

2.1. Write the following proof using `calc`.

      (a + b) * (a + b)
    = a * (a + b) + b * (a + b)
    = a * a + a * b + b * a + b * b
    = a * a + a * b + a * b + b * b
    = a * a + 2 * a * b + b * b

Hint: You might need the tactics `simp` and `cc` and the lemmas `mul_add`,
`add_mul`, and `two_mul`. -/

lemma binomial_square (a b : ℕ) :
  (a + b) * (a + b) = a * a + 2 * a * b + b * b :=
sorry

/-! 2.2 (**optional**). Prove the same argument again, this time as a structured
proof, with `have` steps corresponding to the `calc` equations. Try to reuse as
much of the above proof idea as possible, proceeding mechanically. -/

lemma binomial_square₂ (a b : ℕ) :
  (a + b) * (a + b) = a * a + 2 * a * b + b * b :=
sorry

/-! 2.3. Prove the same lemma again, this time using tactics. -/

lemma binomial_square₃ (a b : ℕ) :
  (a + b) * (a + b) = a * a + 2 * a * b + b * b :=
begin
  sorry
end

/-! ## Question 3 (**optional**): One-Point Rules

3.1 (**optional**). Prove that the following wrong formulation of the one-point
rule for `∀` is inconsistent, using a structured proof. -/

axiom forall.one_point_wrong {α : Type} {t : α} {p : α → Prop} :
  (∀x : α, x = t ∧ p x) ↔ p t

lemma proof_of_false :
  false :=
sorry

/-! 3.2 (**optional**). Prove that the following wrong formulation of the
one-point rule for `∃` is inconsistent, using a tactical or structured proof. -/

axiom exists.one_point_wrong {α : Type} {t : α} {p : α → Prop} :
  (∃x : α, x = t → p x) ↔ p t

lemma proof_of_false₂ :
  false :=
sorry

end LoVe


import topology.algebra.infinite_sum
import data.real.basic
import data.real.nnreal
import algebra.geom_sum

open_locale big_operators
open_locale classical
open finset

notation `|`x`|` := abs x

def seq_limit (u : ℕ → ℝ) (l : ℝ) : Prop :=
∀ ε > 0, ∃ N, ∀ n ≥ N, |u n - l| ≤ ε

def non_decreasing (u : ℕ → ℝ) :=
∀ n m, n ≤ m → u n ≤ u m

def is_seq_sup (M : ℝ) (u : ℕ → ℝ) :=
(∀ n, u n ≤ M) ∧ ∀ ε > 0, ∃ n₀, u n₀ ≥ M - ε

/- The following is a lemma proven from exercises -/

lemma bounded_above_and_increasing_func_converges_to_sup
(M : ℝ) (u : ℕ → ℝ) (h : is_seq_sup M u) (h' : non_decreasing u) :
seq_limit u M :=
begin
  -- get rid off most of the ∀, ∃ statements
  intros ε ε_pos,
  cases h with ha hb,
  cases hb ε ε_pos with n₀ un₀,
  use n₀,
  intros n,
  specialize h' n₀ n,
  intros h'l,
  -- gather hypothesis to prove the desired result
  have inter₁ : u n₀ ≤ u n,
  {
    apply h',
    exact h'l,
  },
  have inter₂ : u n ≥ M - ε, { linarith, },
  have inter₃ : M + ε ≥ u n,
  {
    specialize ha n,
    linarith,
  },
  have inter₂' : M - u n ≤ ε, { linarith, },
  have inter₃' : u n - M ≤ ε, { linarith, },
  rw abs_le,
  split,
  repeat { linarith, },
end

lemma bounded_above_and_increasing_func_converges
(u : ℕ → ℝ) (bounded_above : ∃ x : ℝ, ∀ n : ℕ, u n ≤ x) (increasing : non_decreasing u) :
∃ l : ℝ, seq_limit u l :=
begin
  have non_empty : (∃ (x : ℝ), x ∈ set.range u),
  {
    use u 1,
    use 1,
  },
  -- prove that ∃ supremum
  have inter : (∃ (x : ℝ), ∀ (y : ℝ), x ≤ y ↔ ∀ (z : ℝ), z ∈ set.range u → z ≤ y),
  {
    refine real.exists_sup (set.range u) non_empty _,
    cases bounded_above with x hx,
    use x,
    intros y hy,
    cases hy with n hn,
    specialize hx n,
    linarith,
  },
  -- in inter, x is sup, y is upper bounds, z is (u n)
  cases inter with M hM,
  cases bounded_above with x hx,
  -- simplify the expression
  /- Note: inter' should not prematurely specify y,
   - e.g. have inter' : M ≤ x ↔ ∀ (n : ℕ), u n ≤ x,
   - otherwise cannot be used as the Prop to be contraposed
   -/
  have inter' : ∀ y : ℝ, M ≤ y ↔ ∀ n : ℕ, u n ≤ y,
  {
    intros y,
    rw hM,
    exact set.forall_range_iff,
  },
  -- necessary lemma to be proved so as to prove the current lemma
  have is_sup : ∀ ε > 0, ∃ n₀, u n₀ ≥ M - ε,
  {
    contrapose! inter',
    rcases inter' with ⟨ε, ε_pos, hε⟩,
    use (M - ε / 2),
    rw not_iff,
    rw not_le,
    split,
    {
      intros h1 n,
      specialize hε n,
      linarith,
    },
    {
      intro h,
      linarith,
    },
  },
  -- use everything proved previously to prove the proposition!
  use M,
  refine bounded_above_and_increasing_func_converges_to_sup M u _ increasing,
  split,
  {
    specialize inter' M,
    apply inter'.1,
    linarith,
  },
  {
    exact is_sup,
  },
end

-- The following two lemmas thanks to Jason KY

def partial_sum_to (a : ℕ → ℝ) (n : ℕ) := finset.sum (finset.range n) a
notation `∑` a := partial_sum_to a

lemma sum_diff {a : ℕ → ℝ} {n m : ℕ} (h₁ : n < m) :
(∑ a) m - (∑ a) n = finset.sum (finset.Ico n m) a :=
begin
  unfold partial_sum_to,
  induction m with k hk,
  {
    exfalso,
    from nat.not_succ_le_zero n h₁,
  },
  {
    rw [finset.sum_range_succ, finset.sum_Ico_succ_top],
    swap,
    from nat.lt_succ_iff.mp h₁,
    simp,
    cases nat.lt_succ_iff_lt_or_eq.mp h₁,
    {
      specialize hk h,
      linarith,
    },
    -- the line below somehow doesn't work for proving the first case
    -- {rw [←sub_eq_add_neg, hk h]},
    {
      rw h,
      simp,
    },
  }
end

lemma sum_pos {a : ℕ → ℝ} {n m : ℕ} (h₁ : ∀ k : ℕ, 0 ≤ a k) :
0 ≤ finset.sum (finset.Ico n m) a :=
begin
  induction m with k hk,
  {
    rw finset.Ico.eq_empty_iff.mpr (zero_le n),
    simp,
  },
  {
    cases le_or_lt n k,
    {
      rw finset.sum_Ico_succ_top h,
      from add_nonneg hk (h₁ k),
    },
    {
      rw finset.Ico.eq_empty_iff.mpr (nat.succ_le_iff.mpr h),
      simp,
    },
  },
end

/- The question to be proven in this project:
 - Suppose aₙ ≥ 0 ∀ n and converges to a ∈ [0,1). Prove ∑_{n=1}^∞ aₙ^n converges.
 - you can jump to where "MARK !!!" is to see the core of the proof
 -/
lemma series_of_root_numbers_converges
(a : ℕ → ℝ) (l : ℝ) (h_seq : seq_limit a l) (hu : ∀ n : ℕ, a n ≥ 0) (hl : l ∈ set.Ico (0 : ℝ) 1):
∃ x : ℝ, seq_limit (λ N : ℕ , (∑ (λ n : ℕ, a n ^ n)) N) x :=
begin
  have hann : ∀ n : ℕ, a n ^ n ≥ 0,
  {
    intros n,
    specialize hu n,
    exact pow_nonneg hu n,
  },
  apply bounded_above_and_increasing_func_converges,
  {
    -- prove that the series is bounded above
    unfold seq_limit at h_seq,
    have l_nonneg: l ≥ 0, { exact hl.left, },
    have l_lt_1: l < 1, { exact hl.right, },
    specialize h_seq ((1 - l) / 2) (by linarith),
    cases h_seq with N hN,
    let A : ℝ := (1 + l) / 2,
    have A_pos : A > 0,
    {
      have inter : (1 + l) / 2 > 0, { linarith, },
      exact inter,
    },
    -- Below is the upper bound of the series
    use (((∑ (λ n : ℕ, a n ^ n)) N) + A ^ N / (1 - A)),
    intro n,
    let hN' := hN n,
    have hAN_pos : A ^ N > 0, { exact pow_pos A_pos N, },
    have hAn_pos : A ^ n > 0, { exact pow_pos A_pos n, },
    by_cases n ≤ N,
    {
      -- trivial but unfortunately long proof...
      have hAN : A ^ N / (1 - A) > 0,
      {
        have temp : 1 - A > 0,
        {
          have inter : (1 - (1 + l) / 2 > 0), { linarith, },
          exact inter,
        },
        exact div_pos hAN_pos temp,
      },
      by_cases h' : n = N,
      {
        rw h',
        linarith,
      },
      {
        refine sub_nonneg.mp _,
        have temp_add_sub_comm: ∀ x y z : ℝ, x + y - z = x - z + y,
        {
          intros x y z,
          ring,
        },
        rw temp_add_sub_comm,
        have hnN : n < N,
        { exact lt_of_le_of_ne h h', },
        rw sum_diff hnN,
        have nonneg_sum_diff : 0 ≤ finset.sum (finset.Ico n N) (λ n : ℕ, a n ^ n),
        { exact sum_pos hann, },
        linarith,
      },
    },
    {
      push_neg at h,
      have h' : N ≤ n, { linarith, },
      have A_le_1: A < 1,
      {
        have inter : (1 + l) / 2 < 1, { linarith, },
        exact inter,
      },
      specialize hN' h',
      -- The following cᵢ's are for deducing each line in the calc block later
      have c₁ : (∑λ (n : ℕ), a n ^ n) n - (∑λ (n : ℕ), a n ^ n) N
        = finset.sum (finset.Ico N n) (λ (n : ℕ), a n ^ n),
      { exact sum_diff h, },
      have c₂ : finset.sum (finset.Ico N n) (λ (n : ℕ), a n ^ n)
        ≤ finset.sum (finset.Ico N n) (λ (n : ℕ), A ^ n),
      {
        have temp : ∀ x ∈ Ico N n, a x ^ x ≤ A ^ x,
        {
          intros n' hn'Nn,
          have haA : a n' ≤ (1 + l) / 2,
          {
            specialize hN n' _,
            {
              rw abs_le at hN,
              cases hN,
              linarith,
            },
            {
              rwa Ico.mem at hn'Nn,
              linarith,
            },
          },
          exact pow_le_pow_of_le_left (hu n') haA n',
        },
        exact sum_le_sum temp,
      },
      have c₃ : finset.sum (finset.Ico N n) (λ (n : ℕ), A ^ n)
        = (A ^ n - A ^ N) / (A - 1),
      {
        by exact geom_sum_Ico (by linarith) h',
      },
      have c₄ : (A ^ n - A ^ N) / (A - 1) = (A ^ N - A ^ n) / (1 - A),
      {
        have inter₁ : A - 1 ≠ 0, { linarith, },
        have inter₂ : 1 - A ≠ 0, { linarith, },
        rw div_eq_div_iff inter₁ inter₂,
        linarith,
      },
      have c₅ : (A ^ N - A ^ n) / (1 - A) ≤ A ^ N / (1 - A),
      {
        apply div_le_div,
        repeat { linarith, },
      },
      -- MARK !!!
      -- The following calc block is the holy grail of the proof!
      calc (∑λ (n : ℕ), a n ^ n) n
      = (∑λ (n : ℕ), a n ^ n) N + finset.sum (finset.Ico N n) (λ (n : ℕ), a n ^ n) : by linarith
      ... ≤ (∑λ (n : ℕ), a n ^ n) N + finset.sum (finset.Ico N n) (λ (n : ℕ), A ^ n) : by linarith
      ... = (∑λ (n : ℕ), a n ^ n) N + (A ^ n - A ^ N) / (A - 1) : by linarith
      ... = (∑λ (n : ℕ), a n ^ n) N + (A ^ N - A ^ n) / (1 - A) : by linarith
      ... ≤ (∑λ (n : ℕ), a n ^ n) N + A ^ N / (1 - A) : by linarith,
    },
  },
  {
    -- prove that the series is monotonically increasing
    unfold non_decreasing,
    intros n m hnm,
    rw le_iff_lt_or_eq at hnm,
    cases hnm with hl he,
    {
      refine sub_nonneg.mp _,
      rw sum_diff hl,
      exact sum_pos hann,
    },
    {
      rw le_iff_lt_or_eq,
      right,
      rwa he,
    },
  },
end

/- potentially more general version:
lemma series_of_root_numbers_converges
(a : ℕ → ℝ) (l : ℝ) (h_seq : seq_limit a l) (hu : ∀ n : ℕ, a n ≥ 0)
(l_pos : l ≥ 0) (l_lt_one: l < 1) :
∃ x : ℝ, has_sum (λ n, (a n) ^ n) x :=
begin
  sorry
end
 -/


/-
Copyright (c) 2014 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Leonardo de Moura

Definitions and properties of gcd, lcm, and coprime.
-/
import .div data.nat.gcd
open eq.ops

namespace int

/- gcd -/

definition gcd (a b : ℤ) : ℤ := of_nat (nat.gcd (nat_abs a) (nat_abs b))

theorem gcd_nonneg (a b : ℤ) : gcd a b ≥ 0 :=
of_nat_nonneg (nat.gcd (nat_abs a) (nat_abs b))

theorem gcd.comm (a b : ℤ) : gcd a b = gcd b a :=
by rewrite [↑gcd, nat.gcd.comm]

theorem gcd_zero_right (a : ℤ) : gcd a 0 = abs a :=
by rewrite [↑gcd, nat_abs_zero, nat.gcd_zero_right, of_nat_nat_abs]

theorem gcd_zero_left (a : ℤ) : gcd 0 a = abs a :=
by rewrite [gcd.comm, gcd_zero_right]

theorem gcd_one_right (a : ℤ) : gcd a 1 = 1 :=
by rewrite [↑gcd, nat_abs_one, nat.gcd_one_right]

theorem gcd_one_left (a : ℤ) : gcd 1 a = 1 :=
by rewrite [gcd.comm, gcd_one_right]

theorem gcd_abs_left (a b : ℤ) : gcd (abs a) b = gcd a b :=
by rewrite [↑gcd, *nat_abs_abs]

theorem gcd_abs_right (a b : ℤ) : gcd (abs a) b = gcd a b :=
by rewrite [↑gcd, *nat_abs_abs]

theorem gcd_abs_abs (a b : ℤ) : gcd (abs a) (abs b) = gcd a b :=
by rewrite [↑gcd, *nat_abs_abs]

section
open nat
theorem gcd_of_ne_zero (a : ℤ) {b : ℤ} (H : b ≠ 0) : gcd a b = gcd b (abs a % abs b) :=
have nat_abs b ≠ 0,  from assume H', H (eq_zero_of_nat_abs_eq_zero H'),
have nat_abs b > 0,  from pos_of_ne_zero this,
have nat.gcd (nat_abs a) (nat_abs b) = (nat.gcd (nat_abs b) (nat_abs a % nat_abs b)),
  from @nat.gcd_of_pos (nat_abs a) (nat_abs b) this,
calc
 gcd a b = nat.gcd (nat_abs b) (nat_abs a % nat_abs b) : by rewrite [↑gcd, this]
     ... = gcd (abs b) (abs a % abs b)                 : by rewrite [↑gcd, -*of_nat_nat_abs, of_nat_mod]
     ... = gcd b (abs a % abs b)                       : by rewrite [↑gcd, *nat_abs_abs]
end

theorem gcd_of_pos (a : ℤ) {b : ℤ} (H : b > 0) : gcd a b = gcd b (abs a % b) :=
by rewrite [!gcd_of_ne_zero (ne_of_gt H), abs_of_pos H]

theorem gcd_of_nonneg_of_pos {a b : ℤ} (H1 : a ≥ 0) (H2 : b > 0) : gcd a b = gcd b (a % b) :=
by rewrite [!gcd_of_pos H2, abs_of_nonneg H1]

theorem gcd_self (a : ℤ) : gcd a a = abs a :=
by rewrite [↑gcd, nat.gcd_self, of_nat_nat_abs]

theorem gcd_dvd_left (a b : ℤ) : gcd a b ∣ a :=
have gcd a b ∣ abs a,
  by rewrite [↑gcd, -of_nat_nat_abs, of_nat_dvd_of_nat_iff]; apply nat.gcd_dvd_left,
iff.mp !dvd_abs_iff this

theorem gcd_dvd_right (a b : ℤ) : gcd a b ∣ b :=
by rewrite gcd.comm; apply gcd_dvd_left

theorem dvd_gcd {a b c : ℤ} : a ∣ b → a ∣ c → a ∣ gcd b c :=
begin
  rewrite [↑gcd, -*(abs_dvd_iff a), -(dvd_abs_iff _ b), -(dvd_abs_iff _ c), -*of_nat_nat_abs],
  rewrite [*of_nat_dvd_of_nat_iff] ,
  apply nat.dvd_gcd
end

theorem gcd.assoc (a b c : ℤ) : gcd (gcd a b) c = gcd a (gcd b c) :=
dvd.antisymm !gcd_nonneg !gcd_nonneg
  (dvd_gcd
    (dvd.trans !gcd_dvd_left !gcd_dvd_left)
    (dvd_gcd (dvd.trans !gcd_dvd_left !gcd_dvd_right) !gcd_dvd_right))
  (dvd_gcd
    (dvd_gcd !gcd_dvd_left (dvd.trans !gcd_dvd_right !gcd_dvd_left))
    (dvd.trans !gcd_dvd_right !gcd_dvd_right))

theorem gcd_mul_left (a b c : ℤ) : gcd (a * b) (a * c) = abs a * gcd b c :=
by rewrite [↑gcd, *nat_abs_mul, nat.gcd_mul_left, of_nat_mul, of_nat_nat_abs]

theorem gcd_mul_right (a b c : ℤ) : gcd (a * b) (c * b) = gcd a c * abs b :=
by rewrite [mul.comm a, mul.comm c, mul.comm (gcd a c), gcd_mul_left]

theorem gcd_pos_of_ne_zero_left {a : ℤ} (b : ℤ) (H : a ≠ 0) : gcd a b > 0 :=
have gcd a b ≠ 0, from
  suppose gcd a b = 0,
  have 0 ∣ a,    from this ▸ gcd_dvd_left a b,
  show false,    from H (eq_zero_of_zero_dvd this),
lt_of_le_of_ne (gcd_nonneg a b) (ne.symm this)

theorem gcd_pos_of_ne_zero_right (a : ℤ) {b : ℤ} (H : b ≠ 0) : gcd a b > 0 :=
by rewrite gcd.comm; apply !gcd_pos_of_ne_zero_left H

theorem eq_zero_of_gcd_eq_zero_left {a b : ℤ} (H : gcd a b = 0) : a = 0 :=
decidable.by_contradiction
  (suppose a ≠ 0,
    have gcd a b > 0, from !gcd_pos_of_ne_zero_left this,
    ne_of_lt this H⁻¹)

theorem eq_zero_of_gcd_eq_zero_right {a b : ℤ} (H : gcd a b = 0) : b = 0 :=
by rewrite gcd.comm at H; apply !eq_zero_of_gcd_eq_zero_left H

theorem gcd_div {a b c : ℤ} (H1 : c ∣ a) (H2 : c ∣ b) :
  gcd (a / c) (b / c) = gcd a b / (abs c) :=
decidable.by_cases
  (suppose c = 0,
    calc
      gcd (a / c) (b / c) = gcd 0 0               : by subst c; rewrite *int.div_zero
                          ... = 0                 : gcd_zero_left
                          ... = gcd a b / 0       : int.div_zero
                          ... = gcd a b / (abs c) : by subst c)
  (suppose c ≠ 0,
    have abs c ≠ 0, from assume H', this (eq_zero_of_abs_eq_zero H'),
    eq.symm (int.div_eq_of_eq_mul_left this
      (eq.symm (calc
        gcd (a / c) (b / c) * abs c = gcd (a / c * c) (b / c * c) : gcd_mul_right
                               ... = gcd a (b / c * c)            : int.div_mul_cancel H1
                               ... = gcd a b                      : int.div_mul_cancel H2))))

theorem gcd_dvd_gcd_mul_left (a b c : ℤ) : gcd a b ∣ gcd (c * a) b :=
dvd_gcd (dvd.trans !gcd_dvd_left !dvd_mul_left) !gcd_dvd_right

theorem gcd_dvd_gcd_mul_right (a b c : ℤ) : gcd a b ∣ gcd (a * c) b :=
!mul.comm ▸ !gcd_dvd_gcd_mul_left

theorem div_gcd_eq_div_gcd_of_nonneg {a₁ b₁ a₂ b₂ : ℤ} (H : a₁ * b₂ = a₂ * b₁)
    (H1 : b₁ ≠ 0) (H2 : b₂ ≠ 0) (H3 : a₁ ≥ 0) (H4 : a₂ ≥ 0) :
  a₁ / (gcd a₁ b₁) = a₂ / (gcd a₂ b₂) :=
begin
  apply div_eq_div_of_dvd_of_dvd,
  repeat (apply gcd_dvd_left),
  intro H', apply H1, apply eq_zero_of_gcd_eq_zero_right H',
  intro H', apply H2, apply eq_zero_of_gcd_eq_zero_right H',
  rewrite [-abs_of_nonneg H3 at {1}, -abs_of_nonneg H4 at {2}],
  rewrite [-gcd_mul_left, -gcd_mul_right, H, mul.comm b₁]
end

theorem div_gcd_eq_div_gcd {a₁ b₁ a₂ b₂ : ℤ} (H : a₁ * b₂ = a₂ * b₁) (H1 : b₁ > 0) (H2 : b₂ > 0) :
  a₁ / (gcd a₁ b₁) = a₂ / (gcd a₂ b₂) :=
or.elim (le_or_gt 0 a₁)
  (assume H3 : a₁ ≥ 0,
    have H4 : a₂ * b₁ ≥ 0, by rewrite -H; apply mul_nonneg H3 (le_of_lt H2),
    have H5 : a₂ ≥ 0, from nonneg_of_mul_nonneg_right H4 H1,
    div_gcd_eq_div_gcd_of_nonneg H (ne_of_gt H1) (ne_of_gt H2) H3 H5)
  (assume H3 : a₁ < 0,
    have H4 : a₂ * b₁ < 0, by rewrite -H; apply mul_neg_of_neg_of_pos H3 H2,
    have H5 : a₂ < 0, from neg_of_mul_neg_right H4 (le_of_lt H1),
    have H6 : abs a₁ / (gcd (abs a₁) (abs b₁)) = abs a₂ / (gcd (abs a₂) (abs b₂)),
      begin
        apply div_gcd_eq_div_gcd_of_nonneg,
        rewrite [abs_of_pos H1, abs_of_pos H2, abs_of_neg H3, abs_of_neg H5],
        rewrite [-*neg_mul_eq_neg_mul, H],
        apply ne_of_gt (abs_pos_of_pos H1),
        apply ne_of_gt (abs_pos_of_pos H2),
        repeat (apply abs_nonneg)
      end,
    have H7 : -a₁ / (gcd a₁ b₁) = -a₂ / (gcd a₂ b₂),
      begin
        rewrite [-abs_of_neg H3, -abs_of_neg H5, -gcd_abs_abs a₁],
        rewrite [-gcd_abs_abs a₂ b₂],
        exact H6
      end,
    calc
      a₁ / (gcd a₁ b₁) = -(-a₁ / (gcd a₁ b₁))   :
                             by rewrite [neg_div_of_dvd !gcd_dvd_left, neg_neg]
                     ... = -(-a₂ / (gcd a₂ b₂)) : H7
                     ... = a₂ / (gcd a₂ b₂)     :
                             by rewrite [neg_div_of_dvd !gcd_dvd_left, neg_neg])

/- lcm -/

definition lcm (a b : ℤ) : ℤ := of_nat (nat.lcm (nat_abs a) (nat_abs b))

theorem lcm_nonneg (a b : ℤ) : lcm a b ≥ 0 :=
of_nat_nonneg (nat.lcm (nat_abs a) (nat_abs b))

theorem lcm.comm (a b : ℤ) : lcm a b = lcm b a :=
by rewrite [↑lcm, nat.lcm.comm]

theorem lcm_zero_left (a : ℤ) : lcm 0 a = 0 :=
by rewrite [↑lcm, nat_abs_zero, nat.lcm_zero_left]

theorem lcm_zero_right (a : ℤ) : lcm a 0 = 0 :=
!lcm.comm ▸ !lcm_zero_left

theorem lcm_one_left (a : ℤ) : lcm 1 a = abs a :=
by rewrite [↑lcm, nat_abs_one, nat.lcm_one_left, of_nat_nat_abs]

theorem lcm_one_right (a : ℤ) : lcm a 1 = abs a :=
!lcm.comm ▸ !lcm_one_left

theorem lcm_abs_left (a b : ℤ) : lcm (abs a) b = lcm a b :=
by rewrite [↑lcm, *nat_abs_abs]

theorem lcm_abs_right (a b : ℤ) : lcm (abs a) b = lcm a b :=
by rewrite [↑lcm, *nat_abs_abs]

theorem lcm_abs_abs (a b : ℤ) : lcm (abs a) (abs b) = lcm a b :=
by rewrite [↑lcm, *nat_abs_abs]

theorem lcm_self (a : ℤ) : lcm a a = abs a :=
by rewrite [↑lcm, nat.lcm_self, of_nat_nat_abs]

theorem dvd_lcm_left (a b : ℤ) : a ∣ lcm a b :=
by rewrite [↑lcm, -abs_dvd_iff, -of_nat_nat_abs, of_nat_dvd_of_nat_iff]; apply nat.dvd_lcm_left

theorem dvd_lcm_right (a b : ℤ) : b ∣ lcm a b :=
!lcm.comm ▸ !dvd_lcm_left

theorem gcd_mul_lcm (a b : ℤ) : gcd a b * lcm a b = abs (a * b) :=
begin
  rewrite [↑gcd, ↑lcm, -of_nat_nat_abs, -of_nat_mul, of_nat_eq_of_nat_iff, nat_abs_mul],
  apply nat.gcd_mul_lcm
end

theorem lcm_dvd {a b c : ℤ} : a ∣ c → b ∣ c → lcm a b ∣ c :=
begin
  rewrite [↑lcm, -(abs_dvd_iff a), -(abs_dvd_iff b), -*(dvd_abs_iff _ c), -*of_nat_nat_abs],
  rewrite [*of_nat_dvd_of_nat_iff] ,
  apply nat.lcm_dvd
end

theorem lcm_assoc (a b c : ℤ) : lcm (lcm a b) c = lcm a (lcm b c) :=
dvd.antisymm !lcm_nonneg !lcm_nonneg
  (lcm_dvd
    (lcm_dvd !dvd_lcm_left (dvd.trans !dvd_lcm_left !dvd_lcm_right))
    (dvd.trans !dvd_lcm_right !dvd_lcm_right))
  (lcm_dvd
    (dvd.trans !dvd_lcm_left !dvd_lcm_left)
    (lcm_dvd (dvd.trans !dvd_lcm_right !dvd_lcm_left) !dvd_lcm_right))

/- coprime -/

abbreviation coprime (a b : ℤ) : Prop := gcd a b = 1

theorem coprime_swap {a b : ℤ} (H : coprime b a) : coprime a b :=
!gcd.comm ▸ H

theorem dvd_of_coprime_of_dvd_mul_right {a b c : ℤ} (H1 : coprime c b) (H2 : c ∣ a * b) : c ∣ a :=
have H3 : gcd (a * c) (a * b) = abs a, from
  calc
    gcd (a * c) (a * b) = abs a * gcd c b : gcd_mul_left
                    ... = abs a * 1       : H1
                    ... = abs a           : mul_one,
have H4 : (c ∣ gcd (a * c) (a * b)), from dvd_gcd !dvd_mul_left H2,
by rewrite [-dvd_abs_iff, -H3]; apply H4

theorem dvd_of_coprime_of_dvd_mul_left {a b c : ℤ} (H1 : coprime c a) (H2 : c ∣ a * b) : c ∣ b :=
dvd_of_coprime_of_dvd_mul_right H1 (!mul.comm ▸ H2)

theorem gcd_mul_left_cancel_of_coprime {c : ℤ} (a : ℤ) {b : ℤ} (H : coprime c b) :
   gcd (c * a) b = gcd a b :=
begin
  revert H, unfold [coprime, gcd],
  rewrite [-of_nat_one],
  rewrite [+of_nat_eq_of_nat_iff, nat_abs_mul],
  apply nat.gcd_mul_left_cancel_of_coprime,
end

theorem gcd_mul_right_cancel_of_coprime (a : ℤ) {c b : ℤ} (H : coprime c b) :
   gcd (a * c) b = gcd a b :=
!mul.comm ▸ !gcd_mul_left_cancel_of_coprime H

theorem gcd_mul_left_cancel_of_coprime_right {c a : ℤ} (b : ℤ) (H : coprime c a) :
   gcd a (c * b) = gcd a b :=
!gcd.comm ▸ !gcd.comm ▸ !gcd_mul_left_cancel_of_coprime H

theorem gcd_mul_right_cancel_of_coprime_right {c a : ℤ} (b : ℤ) (H : coprime c a) :
   gcd a (b * c) = gcd a b :=
!gcd.comm ▸ !gcd.comm ▸ !gcd_mul_right_cancel_of_coprime H

theorem coprime_div_gcd_div_gcd {a b : ℤ} (H : gcd a b ≠ 0) :
  coprime (a / gcd a b) (b / gcd a b) :=
calc
  gcd (a / gcd a b) (b / gcd a b)
         = gcd a b / abs (gcd a b) : gcd_div !gcd_dvd_left !gcd_dvd_right
     ... = 1                       : by rewrite [abs_of_nonneg !gcd_nonneg, int.div_self H]

theorem not_coprime_of_dvd_of_dvd {m n d : ℤ} (dgt1 : d > 1) (Hm : d ∣ m) (Hn : d ∣ n) :
  ¬ coprime m n :=
assume co : coprime m n,
have d ∣ gcd m n, from dvd_gcd Hm Hn,
have d ∣ 1, by rewrite [↑coprime at co, co at this]; apply this,
have d ≤ 1, from le_of_dvd dec_trivial this,
show false, from not_lt_of_ge `d ≤ 1` `d > 1`

theorem exists_coprime {a b : ℤ} (H : gcd a b ≠ 0) :
  exists a' b', coprime a' b' ∧ a = a' * gcd a b ∧ b = b' * gcd a b :=
have H1 : a = (a / gcd a b) * gcd a b, from (int.div_mul_cancel !gcd_dvd_left)⁻¹,
have H2 : b = (b / gcd a b) * gcd a b, from (int.div_mul_cancel !gcd_dvd_right)⁻¹,
exists.intro _ (exists.intro _ (and.intro (coprime_div_gcd_div_gcd H) (and.intro H1 H2)))

theorem coprime_mul {a b c : ℤ} (H1 : coprime a c) (H2 : coprime b c) : coprime (a * b) c :=
calc
  gcd (a * b) c = gcd b c : !gcd_mul_left_cancel_of_coprime H1
            ... = 1       : H2

theorem coprime_mul_right {c a b : ℤ} (H1 : coprime c a) (H2 : coprime c b) : coprime c (a * b) :=
coprime_swap (coprime_mul (coprime_swap H1) (coprime_swap H2))

theorem coprime_of_coprime_mul_left {c a b : ℤ} (H : coprime (c * a) b) : coprime a b :=
have H1 : (gcd a b ∣ gcd (c * a) b), from !gcd_dvd_gcd_mul_left,
eq_one_of_dvd_one !gcd_nonneg (H ▸ H1)

theorem coprime_of_coprime_mul_right {c a b : ℤ} (H : coprime (a * c) b) : coprime a b :=
coprime_of_coprime_mul_left (!mul.comm ▸ H)

theorem coprime_of_coprime_mul_left_right {c a b : ℤ} (H : coprime a (c * b)) : coprime a b :=
coprime_swap (coprime_of_coprime_mul_left (coprime_swap H))

theorem coprime_of_coprime_mul_right_right {c a b : ℤ} (H : coprime a (b * c)) : coprime a b :=
coprime_of_coprime_mul_left_right (!mul.comm ▸ H)

theorem exists_eq_prod_and_dvd_and_dvd {a b c : ℤ} (H : c ∣ a * b) :
  ∃ a' b', c = a' * b' ∧ a' ∣ a ∧ b' ∣ b :=
decidable.by_cases
 (suppose gcd c a = 0,
    have c = 0, from eq_zero_of_gcd_eq_zero_left `gcd c a = 0`,
    have a = 0, from eq_zero_of_gcd_eq_zero_right `gcd c a = 0`,
    have c = 0 * b, from `c = 0` ⬝ !zero_mul⁻¹,
    have 0 ∣ a, from `a = 0`⁻¹ ▸ !dvd.refl,
    have b ∣ b, from !dvd.refl,
    exists.intro _ (exists.intro _ (and.intro `c = 0 * b` (and.intro `0 ∣ a` `b ∣ b`))))
  (suppose gcd c a ≠ 0,
    have gcd c a ∣ c, from !gcd_dvd_left,
    have H3 : c / gcd c a ∣ (a * b) / gcd c a, from div_dvd_div this H,
    have H4 : (a * b) / gcd c a = (a / gcd c a) * b, from
      calc
        a * b / gcd c a = b * a / gcd c a     : mul.comm
                      ... = b * (a / gcd c a) : !int.mul_div_assoc !gcd_dvd_right
                      ... = a / gcd c a * b   : mul.comm,
    have H5 : c / gcd c a ∣ (a / gcd c a) * b, from H4 ▸ H3,
    have H6 : coprime (c / gcd c a) (a / gcd c a), from coprime_div_gcd_div_gcd `gcd c a ≠ 0`,
    have H7 : c / gcd c a ∣ b, from dvd_of_coprime_of_dvd_mul_left H6 H5,
    have H8 : c = gcd c a * (c / gcd c a), from (int.mul_div_cancel' `gcd c a ∣ c`)⁻¹,
    exists.intro _ (exists.intro _ (and.intro H8 (and.intro !gcd_dvd_right H7))))

end int