/-
Copyright (c) 2018 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Kenny Lau, Johan Commelin, Mario Carneiro, Kevin Buzzard,
Amelia Livingston, Yury Kudryashov
-/
import group_theory.submonoid.operations
import algebra.big_operators.basic
import algebra.free_monoid
import data.finset.noncomm_prod

/-!
# Submonoids: membership criteria

In this file we prove various facts about membership in a submonoid:

* `list_prod_mem`, `multiset_prod_mem`, `prod_mem`: if each element of a collection belongs
  to a multiplicative submonoid, then so does their product;
* `list_sum_mem`, `multiset_sum_mem`, `sum_mem`: if each element of a collection belongs
  to an additive submonoid, then so does their sum;
* `pow_mem`, `nsmul_mem`: if `x ∈ S` where `S` is a multiplicative (resp., additive) submonoid and
  `n` is a natural number, then `x^n` (resp., `n • x`) belongs to `S`;
* `mem_supr_of_directed`, `coe_supr_of_directed`, `mem_Sup_of_directed_on`,
  `coe_Sup_of_directed_on`: the supremum of a directed collection of submonoid is their union.
* `sup_eq_range`, `mem_sup`: supremum of two submonoids `S`, `T` of a commutative monoid is the set
  of products;
* `closure_singleton_eq`, `mem_closure_singleton`, `mem_closure_pair`: the multiplicative (resp.,
  additive) closure of `{x}` consists of powers (resp., natural multiples) of `x`, and a similar
  result holds for the closure of `{x, y}`.

## Tags
submonoid, submonoids
-/

open_locale big_operators

variables {M A B : Type*}

section assoc
variables [monoid M] [set_like B M] [submonoid_class B M] {S : B}

namespace submonoid_class

@[simp, norm_cast, to_additive] theorem coe_list_prod (l : list S) :
  (l.prod : M) = (l.map coe).prod :=
(submonoid_class.subtype S : _ →* M).map_list_prod l

@[simp, norm_cast, to_additive] theorem coe_multiset_prod {M} [comm_monoid M] [set_like B M]
  [submonoid_class B M] (m : multiset S) : (m.prod : M) = (m.map coe).prod :=
(submonoid_class.subtype S : _ →* M).map_multiset_prod m

@[simp, norm_cast, to_additive] theorem coe_finset_prod {ι M} [comm_monoid M] [set_like B M]
  [submonoid_class B M] (f : ι → S) (s : finset ι) :
  ↑(∏ i in s, f i) = (∏ i in s, f i : M) :=
(submonoid_class.subtype S : _ →* M).map_prod f s

/-- Product of a list of elements in a submonoid is in the submonoid. -/
@[to_additive "Sum of a list of elements in an `add_submonoid` is in the `add_submonoid`."]
lemma list_prod_mem {l : list M} (hl : ∀ x ∈ l, x ∈ S) : l.prod ∈ S :=
by { lift l to list S using hl, rw ← coe_list_prod, exact l.prod.coe_prop }

/-- Product of a multiset of elements in a submonoid of a `comm_monoid` is in the submonoid. -/
@[to_additive "Sum of a multiset of elements in an `add_submonoid` of an `add_comm_monoid` is
in the `add_submonoid`."]
lemma multiset_prod_mem {M} [comm_monoid M] [set_like B M] [submonoid_class B M] (m : multiset M)
  (hm : ∀ a ∈ m, a ∈ S) : m.prod ∈ S :=
by { lift m to multiset S using hm, rw ← coe_multiset_prod, exact m.prod.coe_prop }

/-- Product of elements of a submonoid of a `comm_monoid` indexed by a `finset` is in the
    submonoid. -/
@[to_additive "Sum of elements in an `add_submonoid` of an `add_comm_monoid` indexed by a `finset`
is in the `add_submonoid`."]
lemma prod_mem {M : Type*} [comm_monoid M] [set_like B M] [submonoid_class B M]
  {ι : Type*} {t : finset ι} {f : ι → M} (h : ∀c ∈ t, f c ∈ S) :
  ∏ c in t, f c ∈ S :=
multiset_prod_mem (t.1.map f) $ λ x hx, let ⟨i, hi, hix⟩ := multiset.mem_map.1 hx in hix ▸ h i hi

end submonoid_class

namespace submonoid

variables (s : submonoid M)

@[simp, norm_cast, to_additive] theorem coe_list_prod (l : list s) :
  (l.prod : M) = (l.map coe).prod :=
s.subtype.map_list_prod l

@[simp, norm_cast, to_additive] theorem coe_multiset_prod {M} [comm_monoid M] (S : submonoid M)
  (m : multiset S) : (m.prod : M) = (m.map coe).prod :=
S.subtype.map_multiset_prod m

@[simp, norm_cast, to_additive] theorem coe_finset_prod {ι M} [comm_monoid M] (S : submonoid M)
  (f : ι → S) (s : finset ι) :
  ↑(∏ i in s, f i) = (∏ i in s, f i : M) :=
S.subtype.map_prod f s

/-- Product of a list of elements in a submonoid is in the submonoid. -/
@[to_additive "Sum of a list of elements in an `add_submonoid` is in the `add_submonoid`."]
lemma list_prod_mem {l : list M} (hl : ∀ x ∈ l, x ∈ s) : l.prod ∈ s :=
by { lift l to list s using hl, rw ← coe_list_prod, exact l.prod.coe_prop }

/-- Product of a multiset of elements in a submonoid of a `comm_monoid` is in the submonoid. -/
@[to_additive "Sum of a multiset of elements in an `add_submonoid` of an `add_comm_monoid` is
in the `add_submonoid`."]
lemma multiset_prod_mem {M} [comm_monoid M] (S : submonoid M) (m : multiset M)
  (hm : ∀ a ∈ m, a ∈ S) : m.prod ∈ S :=
by { lift m to multiset S using hm, rw ← coe_multiset_prod, exact m.prod.coe_prop }

@[to_additive]
lemma multiset_noncomm_prod_mem (S : submonoid M) (m : multiset M)
  (comm : ∀ (x ∈ m) (y ∈ m), commute x y) (h : ∀ (x ∈ m), x ∈ S) :
  m.noncomm_prod comm ∈ S :=
begin
  induction m using quotient.induction_on with l,
  simp only [multiset.quot_mk_to_coe, multiset.noncomm_prod_coe],
  exact submonoid.list_prod_mem _ h,
end

/-- Product of elements of a submonoid of a `comm_monoid` indexed by a `finset` is in the
    submonoid. -/
@[to_additive "Sum of elements in an `add_submonoid` of an `add_comm_monoid` indexed by a `finset`
is in the `add_submonoid`."]
lemma prod_mem {M : Type*} [comm_monoid M] (S : submonoid M)
  {ι : Type*} {t : finset ι} {f : ι → M} (h : ∀c ∈ t, f c ∈ S) :
  ∏ c in t, f c ∈ S :=
S.multiset_prod_mem (t.1.map f) $ λ x hx, let ⟨i, hi, hix⟩ := multiset.mem_map.1 hx in hix ▸ h i hi

@[to_additive]
lemma noncomm_prod_mem (S : submonoid M) {ι : Type*} (t : finset ι) (f : ι → M)
  (comm : ∀ (x ∈ t) (y ∈ t), commute (f x) (f y)) (h : ∀ c ∈ t, f c ∈ S) :
  t.noncomm_prod f comm ∈ S :=
begin
  apply multiset_noncomm_prod_mem,
  intro y,
  rw multiset.mem_map,
  rintros ⟨x, ⟨hx, rfl⟩⟩,
  exact h x hx,
end

end submonoid

end assoc

section non_assoc
variables [mul_one_class M]

open set

namespace submonoid

-- TODO: this section can be generalized to `[submonoid_class B M] [complete_lattice B]`
-- such that `complete_lattice.le` coincides with `set_like.le`

@[to_additive]
lemma mem_supr_of_directed {ι} [hι : nonempty ι] {S : ι → submonoid M} (hS : directed (≤) S)
  {x : M} :
  x ∈ (⨆ i, S i) ↔ ∃ i, x ∈ S i :=
begin
  refine ⟨_, λ ⟨i, hi⟩, (set_like.le_def.1 $ le_supr S i) hi⟩,
  suffices : x ∈ closure (⋃ i, (S i : set M)) → ∃ i, x ∈ S i,
    by simpa only [closure_Union, closure_eq (S _)] using this,
  refine (λ hx, closure_induction hx (λ _, mem_Union.1) _ _),
  { exact hι.elim (λ i, ⟨i, (S i).one_mem⟩) },
  { rintros x y ⟨i, hi⟩ ⟨j, hj⟩,
    rcases hS i j with ⟨k, hki, hkj⟩,
    exact ⟨k, (S k).mul_mem (hki hi) (hkj hj)⟩ }
end

@[to_additive]
lemma coe_supr_of_directed {ι} [nonempty ι] {S : ι → submonoid M} (hS : directed (≤) S) :
  ((⨆ i, S i : submonoid M) : set M) = ⋃ i, ↑(S i) :=
set.ext $ λ x, by simp [mem_supr_of_directed hS]

@[to_additive]
lemma mem_Sup_of_directed_on {S : set (submonoid M)} (Sne : S.nonempty)
  (hS : directed_on (≤) S) {x : M} :
  x ∈ Sup S ↔ ∃ s ∈ S, x ∈ s :=
begin
  haveI : nonempty S := Sne.to_subtype,
  simp only [Sup_eq_supr', mem_supr_of_directed hS.directed_coe, set_coe.exists, subtype.coe_mk]
end

@[to_additive]
lemma coe_Sup_of_directed_on {S : set (submonoid M)} (Sne : S.nonempty) (hS : directed_on (≤) S) :
  (↑(Sup S) : set M) = ⋃ s ∈ S, ↑s :=
set.ext $ λ x, by simp [mem_Sup_of_directed_on Sne hS]

@[to_additive]
lemma mem_sup_left {S T : submonoid M} : ∀ {x : M}, x ∈ S → x ∈ S ⊔ T :=
show S ≤ S ⊔ T, from le_sup_left

@[to_additive]
lemma mem_sup_right {S T : submonoid M} : ∀ {x : M}, x ∈ T → x ∈ S ⊔ T :=
show T ≤ S ⊔ T, from le_sup_right

@[to_additive]
lemma mul_mem_sup {S T : submonoid M} {x y : M} (hx : x ∈ S) (hy : y ∈ T) : x * y ∈ S ⊔ T :=
(S ⊔ T).mul_mem (mem_sup_left hx) (mem_sup_right hy)

@[to_additive]
lemma mem_supr_of_mem {ι : Sort*} {S : ι → submonoid M} (i : ι) :
  ∀ {x : M}, x ∈ S i → x ∈ supr S :=
show S i ≤ supr S, from le_supr _ _

@[to_additive]
lemma mem_Sup_of_mem {S : set (submonoid M)} {s : submonoid M}
  (hs : s ∈ S) : ∀ {x : M}, x ∈ s → x ∈ Sup S :=
show s ≤ Sup S, from le_Sup hs

/-- An induction principle for elements of `⨆ i, S i`.
If `C` holds for `1` and all elements of `S i` for all `i`, and is preserved under multiplication,
then it holds for all elements of the supremum of `S`. -/
@[elab_as_eliminator, to_additive /-" An induction principle for elements of `⨆ i, S i`.
If `C` holds for `0` and all elements of `S i` for all `i`, and is preserved under addition,
then it holds for all elements of the supremum of `S`. "-/]
lemma supr_induction {ι : Sort*} (S : ι → submonoid M) {C : M → Prop} {x : M} (hx : x ∈ ⨆ i, S i)
  (hp : ∀ i (x ∈ S i), C x)
  (h1 : C 1)
  (hmul : ∀ x y, C x → C y → C (x * y)) : C x :=
begin
  rw supr_eq_closure at hx,
  refine closure_induction hx (λ x hx, _) h1 hmul,
  obtain ⟨i, hi⟩ := set.mem_Union.mp hx,
  exact hp _ _ hi,
end

/-- A dependent version of `submonoid.supr_induction`. -/
@[elab_as_eliminator, to_additive /-"A dependent version of `add_submonoid.supr_induction`. "-/]
lemma supr_induction' {ι : Sort*} (S : ι → submonoid M) {C : Π x, (x ∈ ⨆ i, S i) → Prop}
  (hp : ∀ i (x ∈ S i), C x (mem_supr_of_mem i ‹_›))
  (h1 : C 1 (one_mem _))
  (hmul : ∀ x y hx hy, C x hx → C y hy → C (x * y) (mul_mem _ ‹_› ‹_›))
  {x : M} (hx : x ∈ ⨆ i, S i) : C x hx :=
begin
  refine exists.elim _ (λ (hx : x ∈ ⨆ i, S i) (hc : C x hx), hc),
  refine supr_induction S hx (λ i x hx, _) _ (λ x y, _),
  { exact ⟨_, hp _ _ hx⟩ },
  { exact ⟨_, h1⟩ },
  { rintro ⟨_, Cx⟩ ⟨_, Cy⟩,
    refine ⟨_, hmul _ _ _ _ Cx Cy⟩ },
end

end submonoid

end non_assoc

namespace free_monoid

variables {α : Type*}

open submonoid

@[to_additive]
theorem closure_range_of : closure (set.range $ @of α) = ⊤ :=
eq_top_iff.2 $ λ x hx, free_monoid.rec_on x (one_mem _) $ λ x xs hxs,
  mul_mem _ (subset_closure $ set.mem_range_self _) hxs

end free_monoid

namespace submonoid

variables [monoid M]

open monoid_hom

lemma closure_singleton_eq (x : M) : closure ({x} : set M) = (powers_hom M x).mrange :=
closure_eq_of_le (set.singleton_subset_iff.2 ⟨multiplicative.of_add 1, pow_one x⟩) $
  λ x ⟨n, hn⟩, hn ▸ submonoid.pow_mem _ (subset_closure $ set.mem_singleton _) _

/-- The submonoid generated by an element of a monoid equals the set of natural number powers of
    the element. -/
lemma mem_closure_singleton {x y : M} : y ∈ closure ({x} : set M) ↔ ∃ n:ℕ, x^n=y :=
by rw [closure_singleton_eq, mem_mrange]; refl

lemma mem_closure_singleton_self {y : M} : y ∈ closure ({y} : set M) :=
mem_closure_singleton.2 ⟨1, pow_one y⟩

lemma closure_singleton_one : closure ({1} : set M) = ⊥ :=
by simp [eq_bot_iff_forall, mem_closure_singleton]

@[to_additive]
lemma closure_eq_mrange (s : set M) : closure s = (free_monoid.lift (coe : s → M)).mrange :=
by rw [mrange_eq_map, ← free_monoid.closure_range_of, map_mclosure, ← set.range_comp,
  free_monoid.lift_comp_of, subtype.range_coe]

@[to_additive]
lemma exists_list_of_mem_closure {s : set M} {x : M} (hx : x ∈ closure s) :
  ∃ (l : list M) (hl : ∀ y ∈ l, y ∈ s), l.prod = x :=
begin
  rw [closure_eq_mrange, mem_mrange] at hx,
  rcases hx with ⟨l, hx⟩,
  exact ⟨list.map coe l, λ y hy, let ⟨z, hz, hy⟩ := list.mem_map.1 hy in hy ▸ z.2, hx⟩
end

@[to_additive]
lemma exists_multiset_of_mem_closure {M : Type*} [comm_monoid M] {s : set M}
  {x : M} (hx : x ∈ closure s) : ∃ (l : multiset M) (hl : ∀ y ∈ l, y ∈ s), l.prod = x :=
begin
  obtain ⟨l, h1, h2⟩ := exists_list_of_mem_closure hx,
  exact ⟨l, h1, (multiset.coe_prod l).trans h2⟩,
end

@[to_additive]
lemma closure_induction_left {s : set M} {p : M → Prop} {x : M} (h : x ∈ closure s) (H1 : p 1)
  (Hmul : ∀ (x ∈ s) y, p y → p (x * y)) : p x :=
begin
  rw closure_eq_mrange at h,
  obtain ⟨l, rfl⟩ := h,
  induction l using free_monoid.rec_on with x y ih,
  { exact H1 },
  { simpa only [map_mul, free_monoid.lift_eval_of] using Hmul _ x.prop _ ih }
end

@[to_additive]
lemma closure_induction_right {s : set M} {p : M → Prop} {x : M} (h : x ∈ closure s) (H1 : p 1)
  (Hmul : ∀ x (y ∈ s), p x → p (x * y)) : p x :=
@closure_induction_left _ _ (mul_opposite.unop ⁻¹' s) (p ∘ mul_opposite.unop) (mul_opposite.op x)
  (closure_induction h (λ x hx, subset_closure hx) (one_mem _) (λ x y hx hy, mul_mem _ hy hx))
  H1 (λ x hx y, Hmul _ _ hx)

/-- The submonoid generated by an element. -/
def powers (n : M) : submonoid M :=
submonoid.copy (powers_hom M n).mrange (set.range ((^) n : ℕ → M)) $
set.ext (λ n, exists_congr $ λ i, by simp; refl)

@[simp] lemma mem_powers (n : M) : n ∈ powers n := ⟨1, pow_one _⟩

lemma mem_powers_iff (x z : M) : x ∈ powers z ↔ ∃ n : ℕ, z ^ n = x := iff.rfl

lemma powers_eq_closure (n : M) : powers n = closure {n} :=
by { ext, exact mem_closure_singleton.symm }

lemma powers_subset {n : M} {P : submonoid M} (h : n ∈ P) : powers n ≤ P :=
λ x hx, match x, hx with _, ⟨i, rfl⟩ := P.pow_mem h i end

/-- Exponentiation map from natural numbers to powers. -/
@[simps] def pow (n : M) (m : ℕ) : powers n :=
(powers_hom M n).mrange_restrict (multiplicative.of_add m)

lemma pow_apply (n : M) (m : ℕ) : submonoid.pow n m = ⟨n ^ m, m, rfl⟩ := rfl

/-- Logarithms from powers to natural numbers. -/
def log [decidable_eq M] {n : M} (p : powers n) : ℕ :=
nat.find $ (mem_powers_iff p.val n).mp p.prop

@[simp] theorem pow_log_eq_self [decidable_eq M] {n : M} (p : powers n) : pow n (log p) = p :=
subtype.ext $ nat.find_spec p.prop

lemma pow_right_injective_iff_pow_injective {n : M} :
  function.injective (λ m : ℕ, n ^ m) ↔ function.injective (pow n) :=
subtype.coe_injective.of_comp_iff (pow n)

@[simp] theorem log_pow_eq_self [decidable_eq M] {n : M} (h : function.injective (λ m : ℕ, n ^ m))
  (m : ℕ) : log (pow n m) = m :=
pow_right_injective_iff_pow_injective.mp h $ pow_log_eq_self _

/-- The exponentiation map is an isomorphism from the additive monoid on natural numbers to powers
when it is injective. The inverse is given by the logarithms. -/
@[simps]
def pow_log_equiv [decidable_eq M] {n : M} (h : function.injective (λ m : ℕ, n ^ m)) :
  multiplicative ℕ ≃* powers n :=
{ to_fun := λ m, pow n m.to_add,
  inv_fun := λ m, multiplicative.of_add (log m),
  left_inv := log_pow_eq_self h,
  right_inv := pow_log_eq_self,
  map_mul' := λ _ _, by { simp only [pow, map_mul, of_add_add, to_add_mul] } }

lemma log_mul [decidable_eq M] {n : M} (h : function.injective (λ m : ℕ, n ^ m))
  (x y : powers (n : M)) : log (x * y) = log x + log y := (pow_log_equiv h).symm.map_mul x y

theorem log_pow_int_eq_self {x : ℤ} (h : 1 < x.nat_abs) (m : ℕ) : log (pow x m) = m :=
(pow_log_equiv (int.pow_right_injective h)).symm_apply_apply _

@[simp] lemma map_powers {N : Type*} [monoid N] (f : M →* N) (m : M) :
  (powers m).map f = powers (f m) :=
by simp only [powers_eq_closure, f.map_mclosure, set.image_singleton]

/-- If all the elements of a set `s` commute, then `closure s` is a commutative monoid. -/
@[to_additive "If all the elements of a set `s` commute, then `closure s` forms an additive
commutative monoid."]
def closure_comm_monoid_of_comm {s : set M} (hcomm : ∀ (a ∈ s) (b ∈ s), a * b = b * a) :
  comm_monoid (closure s) :=
{ mul_comm := λ x y,
  begin
    ext,
    simp only [submonoid.coe_mul],
    exact closure_induction₂ x.prop y.prop hcomm
      (λ x, by simp only [mul_one, one_mul])
      (λ x, by simp only [mul_one, one_mul])
      (λ x y z h₁ h₂, by rw [mul_assoc, h₂, ←mul_assoc, h₁, mul_assoc])
      (λ x y z h₁ h₂, by rw [←mul_assoc, h₁, mul_assoc, h₂, ←mul_assoc]),
  end,
  ..(closure s).to_monoid }

end submonoid

namespace submonoid

variables {N : Type*} [comm_monoid N]

open monoid_hom

@[to_additive]
lemma sup_eq_range (s t : submonoid N) : s ⊔ t = (s.subtype.coprod t.subtype).mrange :=
by rw [mrange_eq_map, ← mrange_inl_sup_mrange_inr, map_sup, map_mrange, coprod_comp_inl,
  map_mrange, coprod_comp_inr, range_subtype, range_subtype]

@[to_additive]
lemma mem_sup {s t : submonoid N} {x : N} :
  x ∈ s ⊔ t ↔ ∃ (y ∈ s) (z ∈ t), y * z = x :=
by simp only [sup_eq_range, mem_mrange, coprod_apply, prod.exists, set_like.exists,
  coe_subtype, subtype.coe_mk]

end submonoid

namespace add_submonoid

variables [add_monoid A]

open set

lemma closure_singleton_eq (x : A) : closure ({x} : set A) = (multiples_hom A x).mrange :=
closure_eq_of_le (set.singleton_subset_iff.2 ⟨1, one_nsmul x⟩) $
  λ x ⟨n, hn⟩, hn ▸ nsmul_mem _ (subset_closure $ set.mem_singleton _) _

/-- The `add_submonoid` generated by an element of an `add_monoid` equals the set of
natural number multiples of the element. -/
lemma mem_closure_singleton {x y : A} :
  y ∈ closure ({x} : set A) ↔ ∃ n:ℕ, n • x = y :=
by rw [closure_singleton_eq, add_monoid_hom.mem_mrange]; refl

lemma closure_singleton_zero : closure ({0} : set A) = ⊥ :=
by simp [eq_bot_iff_forall, mem_closure_singleton, nsmul_zero]

/-- The additive submonoid generated by an element. -/
def multiples (x : A) : add_submonoid A :=
add_submonoid.copy (multiples_hom A x).mrange (set.range (λ i, i • x : ℕ → A)) $
set.ext (λ n, exists_congr $ λ i, by simp; refl)

@[simp] lemma mem_multiples (x : A) : x ∈ multiples x := ⟨1, one_nsmul _⟩

lemma mem_multiples_iff (x z : A) : x ∈ multiples z ↔ ∃ n : ℕ, n • z = x := iff.rfl

lemma multiples_eq_closure (x : A) : multiples x = closure {x} :=
by { ext, exact mem_closure_singleton.symm }

lemma multiples_subset {x : A} {P : add_submonoid A} (h : x ∈ P) : multiples x ≤ P :=
λ x hx, match x, hx with _, ⟨i, rfl⟩ := P.nsmul_mem h i end

attribute [to_additive add_submonoid.multiples] submonoid.powers
attribute [to_additive add_submonoid.mem_multiples] submonoid.mem_powers
attribute [to_additive add_submonoid.mem_multiples_iff] submonoid.mem_powers_iff
attribute [to_additive add_submonoid.multiples_eq_closure] submonoid.powers_eq_closure
attribute [to_additive add_submonoid.multiples_subset] submonoid.powers_subset

end add_submonoid

/-! Lemmas about additive closures of `submonoid`. -/
namespace submonoid

variables {R : Type*} [non_assoc_semiring R] (S : submonoid R) {a b : R}

/-- The product of an element of the additive closure of a multiplicative submonoid `M`
and an element of `M` is contained in the additive closure of `M`. -/
lemma mul_right_mem_add_closure
  (ha : a ∈ add_submonoid.closure (S : set R)) (hb : b ∈ S) :
  a * b ∈ add_submonoid.closure (S : set R) :=
begin
  revert b,
  refine add_submonoid.closure_induction ha _ _ _; clear ha a,
  { exact λ r hr b hb, add_submonoid.mem_closure.mpr (λ y hy, hy (S.mul_mem hr hb)) },
  { exact λ b hb, by simp only [zero_mul, (add_submonoid.closure (S : set R)).zero_mem] },
  { simp_rw add_mul,
    exact λ r s hr hs b hb, (add_submonoid.closure (S : set R)).add_mem (hr hb) (hs hb) }
end

/-- The product of two elements of the additive closure of a submonoid `M` is an element of the
additive closure of `M`. -/
lemma mul_mem_add_closure
  (ha : a ∈ add_submonoid.closure (S : set R)) (hb : b ∈ add_submonoid.closure (S : set R)) :
  a * b ∈ add_submonoid.closure (S : set R) :=
begin
  revert a,
  refine add_submonoid.closure_induction hb _ _ _; clear hb b,
  { exact λ r hr b hb, S.mul_right_mem_add_closure hb hr },
  { exact λ b hb, by simp only [mul_zero, (add_submonoid.closure (S : set R)).zero_mem] },
  { simp_rw mul_add,
    exact λ r s hr hs b hb, (add_submonoid.closure (S : set R)).add_mem (hr hb) (hs hb) }
end

/-- The product of an element of `S` and an element of the additive closure of a multiplicative
submonoid `S` is contained in the additive closure of `S`. -/
lemma mul_left_mem_add_closure (ha : a ∈ S) (hb : b ∈ add_submonoid.closure (S : set R)) :
  a * b ∈ add_submonoid.closure (S : set R) :=
S.mul_mem_add_closure (add_submonoid.mem_closure.mpr (λ sT hT, hT ha)) hb

/-- An element is in the closure of a two-element set if it is a linear combination of those two
elements. -/
@[to_additive "An element is in the closure of a two-element set if it is a linear combination of
those two elements."]

end submonoid

section mul_add

lemma of_mul_image_powers_eq_multiples_of_mul [monoid M] {x : M} :
  additive.of_mul '' ((submonoid.powers x) : set M) = add_submonoid.multiples (additive.of_mul x) :=
begin
  ext,
  split,
  { rintros ⟨y, ⟨n, hy1⟩, hy2⟩,
    use n,
    simpa [← of_mul_pow, hy1] },
  { rintros ⟨n, hn⟩,
    refine ⟨x ^ n, ⟨n, rfl⟩, _⟩,
    rwa of_mul_pow }
end

lemma of_add_image_multiples_eq_powers_of_add [add_monoid A] {x : A} :
  multiplicative.of_add '' ((add_submonoid.multiples x) : set A) =
  submonoid.powers (multiplicative.of_add x) :=
begin
  symmetry,
  rw equiv.eq_image_iff_symm_image_eq,
  exact of_mul_image_powers_eq_multiples_of_mul,
end

end mul_add


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

import tactic -- imports all the Lean tactics

/-!

# Interlude: types.

Lean uses something called "types" instead of sets, as its foundational
way of saying a "collection of stuff". For example, the real numbers
are a type in Lean, a group `G` is a type `G` equipped with a multiplication
and satisfying some axioms, and so on.

Sometimes, especially when making counterexamples, it's helpful to have a way
of making your own types. For example if I asked you to give an example
of a surjective function which wasn't injective then rather than using
Lean's inbuilt types like `ℕ` and `ℝ` you might just want to let `X={a,b}`
and `Y={c}` and define `f(a)=f(b)=c`. In this sheet we learn how to do this.

## Inductive types

There are three ways to make types in Lean. There are function types, quotient
types, and inductive types. Turns out that all types that mathematicians use
to build mathematics are made in one of these three ways. For more information
about all three kinds of types, see the course notes

https://www.ma.imperial.ac.uk/~buzzard/xena/formalising-mathematics-2023/Part_B/threekindsoftypes.html

In this sheet, we will focus on inductive types, which are something like
"types for which you can list all the elements in a certain kind of way".
The definition of the type will basically be the list.

In the rest of this section, the only kinds of types you'll need to know about are
finite types, so let's start by talking about these. Let's make
a type which just has three terms.

-/

-- A type with three terms
inductive X : Type
| a : X
| b : X
| c : X

-- Here `X` is a new type, with three terms whose full names are `X.a`, `X.b` and `X.c`.
-- You can think of `X` as a set, with three elements `X = {X.a, X.b, X.c}`. Typing
-- `X.` gets old very quickly so we `open X` meaning that we don't have to do this.

open X

#check a -- works, and says `a : X`, i.e. type of `a` is `X`.

-- Given a general term `x : X`, you can do `cases x` and Lean will turn one goal into
-- three goals with this command, one for `x = a`, one for `x = b` and one for `x = c`.

example (x : X) : x = a ∨ x = b ∨ x = c :=
begin
  cases x,
  { left, refl, },
  { right, left, refl },
  { right, right, refl },
end

-- How does Lean know that `a` and `b` are *distinct* elements of `X`? If you
-- have `h : a = b` then you can do `cases h` to close any goal, because "there
-- are no cases". Lean knows deep down in its core that different constructors
-- for inductive types produce different terms

example : a ≠ b :=
begin
  -- `a ≠ b` is definitionally equal to `¬ (a = b)` which is
  -- definitionally equal to `a = b → false`. So `intro` works
  intro h,
  -- `h : a = b`
  cases h, -- closes the goal.
end

-- We defined `X` using the `inductive` keyword and these funny `|` "pipe" symbols.
-- If you want to define a function from `X` to another type you can use `def`
-- and the `|` symbols again.

def f : X → ℕ
| a := 37
| b := 42
| c := 0

example : f a = 37 :=
begin
  -- true by definition
  refl
end

-- Here is a proof that `f` is an injective function.
-- At some point in this proof there are 9 goals; you can see them
-- by changing the `;` after `cases y` to a `,`. The semicolon means
-- "apply the next tactic to all the goals produced by the last tactic".

-- Lean 3 is not very good at displaying goals when semicolons are involved;
-- to see the nine goals change `cases y;` to `cases y, end #exit`

example : function.injective f :=
begin
  intros x y h,
  cases x;
  cases y;
  -- at this point there are 9 goals, and for each goal either the conclusion
  -- is true by refl, or there's a false hypothesis `h`.
  try {refl};
  try {cases h},
end


import tactic

-- Этот файл переведен и адаптирован из второй недели курса Formalising Mathematics: https://github.com/ImperialCollegeLondon/formalising-mathematics/tree/master/src/week_2
-- Там же есть продолжение про подгруппы, скачайте репозиторий с помощью
-- `leanproject get ImperialCollegeLondon/formalising-mathematics`
-- И самостоятельно пройдите то, что там есть

namespace itmo.lean

/-
Определим группу как тайпкласс (подробнее: https://leanprover.github.io/theorem_proving_in_lean/type_classes.html), расширяющий `has_mul`, `has_one` и `has_inv`.

`has_mul G` означает, что на `G` определено умножение `* : G → G → G`
`has_one G` означает, что в `G` есть единица `1 : G`
`has_inv G` означает, что есть функция, выдающая обратный для элемента `G`: `⁻¹ : G → G`

Все эти определения - просто нотация, свойства и взаимодействие этих функций надо будет добавить. Определим класс `group` с аксиомами групп:
-/

class group (G : Type) extends has_mul G, has_one G, has_inv G :=
(mul_assoc : ∀ (a b c : G), a * b * c = a * (b * c))
(one_mul : ∀ (a : G), 1 * a = a)
(mul_left_inv : ∀ (a : G), a⁻¹ * a = 1)

/-
Формально, `group G` это структура, в которой есть умножение, 1, обратный элемент, и доказательства аксиом групп. Поскольку `group G` это тайпкласс, то добавить в сигнатуру функции "пусть `G` - группа" нужно, как `(G : Type) [group G]`. Квадратные скобки используются для тайпклассов и автоматически (насколько получится) находятся соответствующие инстансы для `G`.

Обратите внимание, что набор использованных аксиом минимален, например, нет аксиом
`mul_one : ∀ (a : G), a * 1 = a` и
`mul_right_inv : ∀ (a : G), a * a⁻¹ = 1`.

На самом деле, эти аксиомы следуют из основных, и мы это докажем.
-/

namespace group

variables {G : Type} [group G]

lemma mul_left_cancel (a b c : G) (Habac : a * b = a * c) : b = c :=
begin
  rw ← one_mul b,
  rw ← one_mul c,
  rw ← mul_left_inv a,
  rw mul_assoc,
  rw mul_assoc,
  rw Habac,
end

-- Доказательства из длинных цепочек равенств или неравенств часто можно заменить на `calc` (справка по `calc`: https://leanprover-community.github.io/extras/calc.html)
-- Пример решения задачи с IMO 2020 с использованием `calc`: https://github.com/leanprover-community/mathlib/blob/master/archive/imo/imo2020_q2.lean

example (a b c : G) (Habac : a * b = a * c) : b = c :=
begin
 calc b = 1 * b         : by rw one_mul
    ... = (a⁻¹ * a) * b : by rw ← mul_left_inv a
    ... = a⁻¹ * (a * b) : by rw ← mul_assoc
    ... = a⁻¹ * (a * c) : by rw Habac
    ... = (a⁻¹ * a) * c : by rw ← mul_assoc
    ... = 1 * c         : by rw mul_left_inv a
    ... = c             : by rw one_mul,
end

lemma mul_eq_of_eq_inv_mul {a x y : G} (h : x = a⁻¹ * y) : a * x = y :=
begin
  apply mul_left_cancel,
  rwa [← mul_assoc, mul_left_inv, one_mul],
end

variables (a b c x y : G)

/-
Попробуйте начать доказательство с `apply mul_eq_of_eq_inv_mul`.
-/

@[simp] theorem mul_one : a * 1 = a :=
begin
  exact mul_eq_of_eq_inv_mul (mul_left_inv _).symm,
end

@[simp] theorem mul_right_inv : a * a⁻¹ = 1 :=
begin
  exact mul_eq_of_eq_inv_mul (mul_one _).symm,
end

/-

Хорошей идеей было бы научить `simp` работать с леммами вида `A = B` или `A ↔ B`, которые мы описали выше. Для этого мы написали атрибут `@[simp]` перед леммой. В идеале, хочется, чтобы равенства в группах решались автоматически:

`example : (a * b) * 1⁻¹⁻¹ * b⁻¹ * (a⁻¹ * a⁻¹⁻¹⁻¹) * a = 1`

Тактика `simp` будет пытаться "упростить" цель как можно больше, в идеале закрыть цель с помощью известных ей лемм. `simp` работает переписываниями, только используя переписывания слева направо (если хочется изменить направление, можно дать дополнительный аргумент `simp [← h] at ...`). Поэтому, в тождествах, помеченных `simp`, правая часть должна быть "проще", чем левая. В частности, `add_comm (a b : ℕ) : a + b = b + a` - плохая лемма для `simp`. Обратите внимание, что во всех леммах выше, например,

`@[simp] theorem mul_one (a : G) : a * 1 = a`
`@[simp] theorem mul_right_inv (a : G) : a * a⁻¹ = 1`

правая часть проще левой. Помечать равенство  `a = a * 1` тегом `@[simp]` - плохая идея.

Уже определенным функциям (или определенным в другом файле) можно ретроспективно проставить атрибуты вручную.
-/

attribute [simp] one_mul mul_left_inv mul_assoc

/-
Научим `simp` использовать следующие пять лемм:

`inv_mul_cancel_left : a⁻¹ * (a * b) = b`
`mul_inv_cancel_left : a * (a⁻¹ * b) = b`
`inv_mul : (a * b)⁻¹ = b⁻¹ * a⁻¹`
`one_inv : (1 : G)⁻¹ = 1`
`inv_inv : (a⁻¹)⁻¹ = a`

Обратите внимание, что везде правая часть "проще" левой.
-/

@[simp] lemma inv_mul_cancel_left : a⁻¹ * (a * b) = b :=
begin
  rw ← mul_assoc,
  -- Здесь уже `simp` сможет переписать `a⁻¹ * a = 1` и `1 * b = b`
  simp,
end

@[simp] lemma mul_inv_cancel_left : a * (a⁻¹ * b) = b :=
begin
  rw [← mul_assoc],
  simp,
end

@[simp] lemma inv_mul : (a * b)⁻¹ = b⁻¹ * a⁻¹ :=
begin
  apply mul_left_cancel (a * b),
  rw mul_right_inv,
  simp,
end

@[simp] lemma one_inv : (1 : G)⁻¹ = 1 :=
begin
  apply mul_left_cancel (1 : G),
  rw mul_right_inv,
  simp,
end

@[simp] lemma inv_inv : a ⁻¹ ⁻¹ = a :=
begin
  apply mul_left_cancel a⁻¹,
  simp,
end

/-
Эти 5 лемм выбраны неспроста: это вывод алгоритма Кнута-Бендикса для переписываний в группе:

https://en.wikipedia.org/wiki/Word_problem_(mathematics)#Example:_A_term_rewriting_system_to_decide_the_word_problem_in_the_free_group
-/

-- Сложный пример теперь решается автоматически
example : (a * b) * 1⁻¹⁻¹ * b⁻¹ * (a⁻¹ * a⁻¹⁻¹⁻¹) * a = 1 := by simp

lemma eq_mul_inv_of_mul_eq {a b c : G} (h : a * c = b) : a = b * c⁻¹ :=
begin
  rw ← h,
  simp,
end

lemma eq_inv_mul_of_mul_eq {a b c : G} (h : b * a = c) : a = b⁻¹ * c :=
begin
  rw ← h,
  simp,
end

lemma mul_left_eq_self {a b : G} : a * b = b ↔ a = 1 :=
begin
  split, {
    intro h,
    replace h := congr_arg (λ x, x * b⁻¹) h,
    simpa using h,
  }, {
    intro h,
    simp [h],
  }
end

lemma mul_right_eq_self {a b : G} : a * b = a ↔ b = 1 :=
begin
  split, {
    intro h,
    replace h := congr_arg (λ x, a⁻¹ * x) h,
    simp at h,
    exact h,
  }, {
    intro h,
    simp [h],
  }
end

lemma eq_inv_of_mul_eq_one {a b : G} (h : a * b = 1) : a = b⁻¹ :=
calc  a = a * 1 : by rw mul_one
    ... = a * (b * b⁻¹) : by rw mul_right_inv
    ... = (a * b) * b⁻¹ : by rw mul_assoc
    ... = 1 * b⁻¹ : by rw h
    ... = b⁻¹   : one_mul _

lemma inv_eq_of_mul_eq_one {a b : G} (h : a * b = 1) : a⁻¹ = b :=
begin
  replace h := eq_inv_of_mul_eq_one h,
  simp [h],
end

lemma unique_left_id {e : G} (h : ∀ x : G, e * x = x) : e = 1 :=
begin
  have h1 := h 1,
  simpa using h1,
end

lemma unique_right_inv {a b : G} (h : a * b = 1) : b = a⁻¹ :=
begin
  apply mul_left_cancel a,
  simp [h],
end

lemma mul_left_cancel_iff (a x y : G) : a * x = a * y ↔ x = y :=
begin
  split,
  { apply mul_left_cancel },
  { intro hxy,
    rwa hxy }
end

-- В режим `calc` можно войти даже вне блока begin-end
lemma mul_right_cancel (a x y : G) (Habac : x * a = y * a) : x = y :=
calc x = x * 1 : by rw mul_one
  ... = x * (a * a⁻¹) : by rw ← mul_right_inv
  ... = (x * a) * a⁻¹ : by rw ← mul_assoc
  ... = (y * a) * a⁻¹ : by rw Habac
  ... = y * (a * a⁻¹) : by rw mul_assoc
  ... = y * 1 : by rw mul_right_inv
  ... = y : by rw mul_one

@[simp] theorem inv_inj_iff {a b : G}: a⁻¹ = b⁻¹ ↔ a = b :=
begin
  split, {
    intro h,
    rw [← inv_inv a, h, inv_inv],
  }, {
    rintro rfl,
    refl,
  }
end

theorem inv_eq {a b : G}: a⁻¹ = b ↔ b⁻¹ = a :=
begin
  split,
  all_goals {
    rintro rfl,
    simp only [inv_inv],
  },
end

end group

end itmo.lean


import algebra.group algebra.group_power

variables {G: Type*}

theorem Q_03 [hG: group G]:
  (∀ a b: G, (a * b) ^ 2 = a ^ 2 * b ^ 2) → comm_group G :=
λ h, begin

  have lem: ∀ a b: G, a * (a * b) * b = a * (b * a) * b,
    from λ a b, calc a * (a * b) * b
    = a * a * (b * b)         : by rw [←mul_assoc, mul_assoc]
... = a * a ^ 1 * (b * b ^ 1) : by rw [pow_one, pow_one]
... = a ^ 2 * b ^ 2           : by rw [←pow_succ, ←pow_succ]
... = (a * b) ^ 2             : (h a b).symm
... = a * b * (a * b)         : by rw [pow_succ, pow_one]
... = a * (b * a) * b         : by rw [←mul_assoc, ←mul_assoc],

  have comm: ∀ a b: G, a * b = b * a,
  from λ a b, mul_left_cancel (mul_right_cancel (lem a b)),

  -- G is a group, together with comm, show that
  -- G is an abelian group:
  exact { mul_comm := comm, .. hG },
end


import analysis.specific_limits
import data.int.parity
import topology.sequences

attribute [instance] classical.prop_decidable

/-
Lemmas from that file were hidden in my course, or restating things which
were proved without name in previous files.
-/

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

-- The mathlib version is unusable because it is stated in terms of ≤
lemma ge_max_iff {α : Type*} [linear_order α] {p q r : α} : r ≥ max p q  ↔ r ≥ p ∧ r ≥ q :=
max_le_iff

/- No idea why this is not in mathlib-/
lemma eq_of_abs_sub_le_all (x y : ℝ) : (∀ ε > 0, |x - y| ≤ ε) → x = y :=
begin
  intro h,
  apply eq_of_abs_sub_nonpos,
  by_contradiction H,
  push_neg at H,
  specialize h ( |x-y|/2) (by linarith),
  linarith,
end

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

lemma unique_limit {u l l'} : seq_limit u l → seq_limit u l' → l = l' :=
begin
  intros hl hl',
  apply eq_of_abs_sub_le_all,
  intros ε ε_pos,
  specialize hl (ε/2) (by linarith),
  cases hl with N hN,
  specialize hl' (ε/2) (by linarith),
  cases hl' with N' hN',
  specialize hN (max N N') (le_max_left _ _),
  specialize hN' (max N N') (le_max_right _ _),
  calc |l - l'| = |(l-u (max N N')) + (u (max N N') -l')| : by ring
  ... ≤ |l - u (max N N')| + |u (max N N') - l'| : by apply abs_add
  ... =  |u (max N N') - l| + |u (max N N') - l'| : by rw abs_sub
  ... ≤ ε/2 + ε/2 : by linarith
  ... = ε : by ring,
end

lemma le_of_le_add_all {x y : ℝ} :
  (∀ ε > 0, y ≤ x + ε) →  y ≤ x :=
begin
  contrapose!,
  intro h,
  use (y-x)/2,
  split ; linarith,
end

def upper_bound (A : set ℝ) (x : ℝ) := ∀ a ∈ A, a ≤ x

def is_sup (A : set ℝ) (x : ℝ) := upper_bound A x ∧ ∀ y, upper_bound A y → x ≤ y

lemma lt_sup {A : set ℝ} {x : ℝ} (hx : is_sup A x) :
∀ y, y < x → ∃ a ∈ A, y < a :=
begin
  intro y,
  contrapose!,
  exact hx.right y,
end

lemma squeeze {u v w : ℕ → ℝ} {l} (hu : seq_limit u l) (hw : seq_limit w l)
(h : ∀ n, u n ≤ v n)
(h' : ∀ n, v n ≤ w n) : seq_limit v l :=
begin
  intros ε ε_pos,
  cases hu ε ε_pos with N hN,
  cases hw ε ε_pos with N' hN',
  use max N N',
  intros n hn,
  rw ge_max_iff at hn,
  specialize hN n (by linarith),
  specialize hN' n (by linarith),
  specialize h n,
  specialize h' n,
  rw abs_le at *,
  split ; linarith
end

def extraction (φ : ℕ → ℕ) := ∀ n m, n < m → φ n < φ m

def tendsto_infinity (u : ℕ → ℝ) := ∀ A, ∃ N, ∀ n ≥ N, u n ≥ A

lemma lim_le {x y : ℝ} {u : ℕ → ℝ} (hu : seq_limit u x)
  (ineg : ∀ n, u n ≤ y) : x ≤ y :=
begin
  apply le_of_le_add_all,
  intros ε ε_pos,
  cases hu ε ε_pos with N hN,
  specialize hN N (by linarith),
  specialize ineg N,
  rw abs_le at hN,
  linarith,
end

lemma inv_succ_le_all :  ∀ ε > 0, ∃ N : ℕ, ∀ n ≥ N, 1/(n + 1 : ℝ) ≤ ε :=
begin
  convert metric.tendsto_at_top.mp (tendsto_one_div_add_at_top_nhds_0_nat),
  apply propext,
  simp only [real.dist_eq, sub_zero],
  split,
    intros h ε ε_pos,
    cases h (ε/2) (by linarith) with N hN,
    use N,
    intros n hn,
    rw abs_of_pos (nat.one_div_pos_of_nat : 1/(n+1 : ℝ) > 0),
    specialize hN n hn,
    linarith,
  intros h ε ε_pos,
  cases h ε (by linarith) with N hN,
  use N,
  intros n hn,
  specialize hN n hn,
  rw abs_of_pos (@nat.one_div_pos_of_nat ℝ _ n) at hN,
  linarith,
end

lemma limit_const (x : ℝ) : seq_limit (λ n, x) x :=
λ ε ε_pos, ⟨0, λ _ _, by simp [le_of_lt ε_pos]⟩

lemma limit_of_sub_le_inv_succ {u : ℕ → ℝ} {x : ℝ} (h : ∀ n, |u n - x| ≤ 1/(n+1)) :
seq_limit u x :=
begin
  intros ε ε_pos,
  rcases inv_succ_le_all ε ε_pos with ⟨N, hN⟩,
  use N,
  intros n hn,
  specialize h n,
  specialize hN n hn,
  linarith,
end

lemma limit_const_add_inv_succ (x : ℝ) : seq_limit (λ n, x + 1/(n+1)) x :=
limit_of_sub_le_inv_succ (λ n, by rw abs_of_pos ; linarith [@nat.one_div_pos_of_nat ℝ _ n])

lemma limit_const_sub_inv_succ (x : ℝ) : seq_limit (λ n, x - 1/(n+1)) x :=
begin
  refine limit_of_sub_le_inv_succ (λ n, _),
  rw [show x - 1 / (n + 1) - x = -(1/(n+1)), by ring, abs_neg,  abs_of_pos],
  linarith [@nat.one_div_pos_of_nat ℝ _ n]
end

lemma id_le_extraction {φ}: extraction φ → ∀ n, n ≤ φ n :=
begin
  intros hyp n,
  induction n with n hn,
  { exact nat.zero_le _ },
  { exact nat.succ_le_of_lt (by linarith [hyp n (n+1) (by linarith)]) },
end

lemma seq_limit_id : tendsto_infinity (λ n, n) :=
begin
  intros A,
  cases exists_nat_gt A with N hN,
  use N,
  intros n hn,
  have : (n : ℝ) ≥ N, exact_mod_cast hn,
  linarith,
end

variables {u : ℕ → ℝ} {l : ℝ} {φ : ℕ → ℕ}

open set filter

def cluster_point (u : ℕ → ℝ) (a : ℝ) :=
∃ φ, extraction φ ∧ seq_limit (u ∘ φ) a

lemma bolzano_weierstrass {a b : ℝ} {u : ℕ → ℝ} (h : ∀ n, u n ∈ Icc a b) :
∃ c ∈ Icc a b, cluster_point u c :=
begin
  rcases (compact_Icc : is_compact (Icc a b)).tendsto_subseq h with ⟨c, c_in, φ, hφ, lim⟩,
  use [c, c_in, φ, hφ],
  simp_rw [metric.tendsto_nhds, eventually_at_top, real.dist_eq] at lim,
  intros ε ε_pos,
  rcases lim ε ε_pos with ⟨N, hN⟩,
  use N,
  intros n hn,
  exact le_of_lt (hN n hn)
end

lemma not_seq_limit_of_tendstoinfinity {u : ℕ → ℝ} :
  tendsto_infinity u → ∀ x, ¬ seq_limit u x :=
begin
  intros lim_infinie x lim_x,
  cases lim_x 1 (by linarith) with N hN,
  cases lim_infinie (x+2) with N' hN',
  let N₀ := max N N',
  specialize hN N₀ (le_max_left _ _),
  specialize hN' N₀ (le_max_right _ _),
  rw abs_le at hN,
  linarith,
end

open real

lemma sup_segment {a b : ℝ} {A : set ℝ} (hnonvide : ∃ x, x ∈ A) (h : A ⊆ Icc a b) :
  ∃ x ∈ Icc a b, is_sup A x :=
begin
  have b_maj :  ∀ (y : ℝ), y ∈ A → y ≤ b,
    from λ y y_in, (h y_in).2,
  have Sup_maj : upper_bound A (Sup A),
  { intro x,
    apply real.le_Sup,
    use [b, b_maj] } ,
  refine ⟨Sup A, _, _⟩,
  { split,
    { cases hnonvide with x x_in,
      exact le_trans (h x_in).1 (Sup_maj _ x_in) },
    { apply Sup_le_ub A hnonvide b_maj } },
  { use Sup_maj,
    intros y y_in,
    rwa real.Sup_le _ hnonvide ⟨b, b_maj⟩ },
end

lemma subseq_tendsto_of_tendsto (h : seq_limit u l) (hφ : extraction φ) :
seq_limit (u ∘ φ) l :=
begin
  intros ε ε_pos,
  cases h ε ε_pos with N hN,
  use N,
  intros n hn,
  apply hN,
  calc N ≤ n   : hn
     ... ≤ φ n : id_le_extraction hφ n,
end
namespace tactic.interactive
open tactic

meta def check_me : tactic unit :=
`[ { repeat { unfold seq_limit},
   repeat { unfold continue_en },
   push_neg,
   try { simp only [exists_prop] },
   try { exact iff.rfl },
   done } <|> fail "That's not quite right. Please try again." ]

end tactic.interactive


import .basic
import prelim.intervals
import prelim.collections prelim.embed prelim.size prelim.induction prelim.minmax finsum.fin_api
import matroid.pointcount matroid.submatroid.minor_iso

noncomputable theory
open_locale classical big_operators

open set matroid

variables {α β : Type*} [fintype α] [comm_semiring β] [no_zero_divisors β]

/-- the size of a projective geometry over a `q`-element field; i.e `1 + q + q^2 + ... + q^{n-1}` -/
def pg_size' : β → ℕ → β
| q 0     := 0
| q (n+1) := 1 + q * (pg_size' q n)

@[simp] lemma pg_size'_zero (q : β) : pg_size' q 0 = 0 := rfl

@[simp] lemma pg_size'_succ {q : β}{n : ℕ}: pg_size' q n.succ = 1 + q * (pg_size' q n) := rfl

@[simp] lemma pg_size'_order_one (n : ℕ) : pg_size' (1 : ℤ) n = n :=
by {induction n with n ih, simp, simp [pg_size', ih, add_comm]  }

lemma pg_size'_eq_powsum (q : β) (n : ℕ) : pg_size' q n = ∑ᶠ i in Ico 0 n , q^i  :=
begin
  induction n with n ih,
    simp,
  rw [pg_size', ih], rw mul_distrib_finsum_in q,
  conv in (_ * _) {rw ← pow_succ},
  rw [← pow_zero q, finsum_Ico_shift, Ico_ℕ_eq_Ioo, nat.zero_add, nat.sub_self,
   ← finsum_in_insert, Ioo_insert_left_eq_Ico];
  simp [set.Ioo_ℕ_finite],
end

lemma pg_size'_rat (q : ℤ) (n : ℕ) (hq : 2 ≤ q) : (pg_size' q n : ℚ) = (q^n - 1)/(q - 1) :=
begin
  induction n with n ih,
    simp,
  replace hq : (q : ℚ) -1 ≠ 0 := by {norm_cast, linarith},
  rw [pg_size', ih, ← mul_div_assoc, one_add_div hq, div_left_inj' hq, pow_succ],
  ring,
end

/- the size of a rank-`n` projective geometry over `GF(q)`, or equivalently the value of the sum
`1 + q + q² + q³ + ... + q^{n-1}` For convenience, this is defined for all integers `n`, taking
the value `0` if `n ≤ 0`.  -/
def pg_size (q n : ℤ) := pg_size' q n.to_nat

lemma pg_size_eq_zero (q n : ℤ)(hn : n ≤ 0) : pg_size q n = 0 :=
by {rw pg_size, convert pg_size'_zero q, rw int.to_nat_zero_of_nonpos hn, }

lemma pg_size_rec (q : ℤ) {n : ℤ} (hn : 1 ≤ n) : pg_size q n = 1 + q * (pg_size q (n-1)) :=
begin
  rw [pg_size, pg_size],
  obtain ⟨m,rfl⟩ := int.eq_coe_of_zero_le (by linarith : 0 ≤ n),
  norm_num,
  cases m, exfalso, norm_num at hn, refl,
end

lemma pg_size_eq_powsum (q n : ℤ) : pg_size q n = ∑ᶠ i in Ico 0 n.to_nat, q^i  :=
begin
  cases le_or_lt n 0 with hn hn',
  { convert finsum_in_empty.symm,
    exact pg_size_eq_zero q n hn,
    apply Ico_eq_empty,
    rw int.to_nat_zero_of_nonpos hn,  },
  convert pg_size'_eq_powsum q n.to_nat,
end

lemma pg_size_nonneg (q n : ℤ)(hq : 0 ≤ q): 0 ≤ pg_size q n :=
by {rw pg_size_eq_powsum, exact nonneg_of_finsum_in_nonneg (λ i hi, pow_nonneg hq i)}

/- Kung's lemma - the number of points in a rank-`r` matroid with no `U_{2,q+2}`-minor is at most
`1 + q + q^2 + ... + q^{n-1}`. -/
theorem rank_le_rank_pg_of_no_line {q : ℤ} (hq : 1 ≤ q) {M : matroid α} :
  M.has_no_line_minor (q+2) → M.ε univ ≤ pg_size q (M.rank) :=
begin
  /- If the result fails, we can choose M to be a minimal counterexample-/
  rw rank, revert M,
  by_contra hn,
  obtain ⟨M,hM⟩ := min_counterexample_nonneg_int_param
    _ (λ (M : matroid α), size (M.nonloops)) (λ s, size_nonneg _) hn,
  push_neg at hM,
  rcases hM with ⟨⟨hMq, hMs⟩, hM_min⟩,

  /- The counterexample doesn't have rank zero, so it has a nonloop e-/
  by_cases hr : M.r univ ≤ 0,
  { linarith [pg_size_nonneg q (M.r univ) (by linarith : 0 ≤ q),
              ε_eq_r_of_r_le_one (by linarith: M.r univ ≤ 1)]},
  obtain ⟨e,-,he⟩ := contains_nonloop_of_one_le_rank (lt_of_not_ge' hr),

  /- Write ε M in terms of the sum of lengths of lines through e-/
  rw ε_as_ε_proj_nonloop he at hMs,

  /- These lines all contain at most q points other than e... -/
  set lines := {L : set α | M.is_line L ∧ e ∈ L} with hlines,
  have h_L_ub : ∀ L ∈ lines, M.ε L -1 ≤ q,
  { rintros L ⟨hL,-⟩, exact int.sub_right_le_of_le_add (line_restr_ub_ε (by linarith) hMq hL)},

  /- ... so we can get an upper bound on the sum of their lengths, which then translates to an
  upper bound in terms of `ε (M ⟋ e)`.  . -/
  have h_le : ∑ᶠ (L : set α) in lines, (M.ε L - 1) ≤  q * ((M ⟋ {e}).ε univ),
  { convert fin.finsum_in_le_finsum_in h_L_ub,
    rw [int.finsum_in_const_eq_mul_size, hlines, ε_proj_nonloop _ he]},

  /- Since `M ⟋ e` isn't a counterexample, it doesn't have too many points  -/
  specialize hM_min (M ⟋ {e})
    (size_strict_monotone (project_nonloop_fewer_nonloops he))
    (pminor_has_no_uniform_minor (by norm_num) (by linarith) (pr_is_pminor M {e}) hMq),

  /- Now `M`, being a counterexample, has lots of points, whereas `M ⟋ e` doesn't have too many.
  This is a contradiction. -/
  have hlt := calc
    pg_size q (M.r univ)  < 1 + ∑ᶠ (L : set α) in lines, (M.ε L - 1)
                        : hMs
                      ... ≤ 1 + q * (M ⟋ {e}).ε univ
                        : add_le_add_left h_le 1
                      ... ≤ 1 + q * (pg_size q ((M ⟋ {e}).r univ))
                        : add_le_add_left ((mul_le_mul_left (by linarith : 0 < q)).mpr hM_min) 1,

  rw [project_r, univ_union, rank_nonloop he, ← pg_size_rec q (by linarith : 1 ≤ M.r univ)] at hlt,
  exact lt_irrefl _ hlt,
end

theorem rank_set_le_rank_pg_of_no_line {q : ℤ}(hq : 1 ≤ q){α : Type*} [fintype α] {M : matroid α}
(X : set α) (h : M.has_no_line_minor (q+2)):
  M.ε X ≤ pg_size q (M.r X) :=
begin
  rw ← ε_loopify_to_eq_ε,
  convert rank_le_rank_pg_of_no_line hq _ using 1,
  { rw [loopify_to_r, univ_inter]},
  exact pminor_has_no_uniform_minor (by norm_num : (1 : ℤ) ≤ 2) (by linarith : 2 ≤ q + 2)
    (lp_is_pminor _ _) h,
end

/-
  This is (almost) boilerplate for the fact that a minimal counterexample has no parallel pairs.
  Not needed for the proof above, as it turned out, but may be useful later.

  have no_parallel : ∀ e f, M.parallel e f → e = f,
  { by_contra hn', push_neg at hn', obtain ⟨e,f,hef,hne⟩ := hn',
    set M' := M ⟍ {f} with hM',
    specialize hM_min M'
      (size_strict_monotone (loopify_nonloop_fewer_nonloops hef.nonloop_right))
      (pminor_has_no_uniform_minor (by norm_num) (by linarith) (lp_is_pminor M {f}) hMq),
    rw [rank_nat, r_nat] at hM_min hMs,
    rw [hM', rank_eq_rank_loopify_parallel hef hne,
          ε_loopify_parallel _ (ne.symm hne) (hef.symm)] at hM_min,
    exact lt_irrefl _ (lt_of_le_of_lt hM_min hMs)},

  have h' : M.is_simple_set (M.nonloops),
  { rw [simple_set_iff_no_loops_or_parallel_pairs, loopless_set_iff_subset_nonloops],
     refine ⟨subset.refl _, λ e f _ _ hef, no_parallel e f hef⟩},

  clear no_parallel hn,

-/


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

/-!
# p-adic norm

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

This file defines the `p`-adic norm on `ℚ`.

The `p`-adic valuation on `ℚ` is the difference of the multiplicities of `p` in the numerator and
denominator of `q`. This function obeys the standard properties of a valuation, with the appropriate
assumptions on `p`.

The valuation induces a norm on `ℚ`. This norm is a nonarchimedean absolute value.
It takes values in {0} ∪ {1/p^k | k ∈ ℤ}.

## Notations

This file uses the local notation `/.` for `rat.mk`.

## Implementation notes

Much, but not all, of this file assumes that `p` is prime. This assumption is inferred automatically
by taking `[fact p.prime]` as a type class argument.

## References

* [F. Q. Gouvêa, *p-adic numbers*][gouvea1997]
* [R. Y. Lewis, *A formal proof of Hensel's lemma over the p-adic integers*][lewis2019]
* <https://en.wikipedia.org/wiki/P-adic_number>

## Tags

p-adic, p adic, padic, norm, valuation
-/

/-- If `q ≠ 0`, the `p`-adic norm of a rational `q` is `p ^ -padic_val_rat p q`.
If `q = 0`, the `p`-adic norm of `q` is `0`. -/
def padic_norm (p : ℕ) (q : ℚ) : ℚ := if q = 0 then 0 else (p : ℚ) ^ -padic_val_rat p q

namespace padic_norm

open padic_val_rat
variables {p : ℕ}

/-- Unfolds the definition of the `p`-adic norm of `q` when `q ≠ 0`. -/
@[simp] protected lemma eq_zpow_of_nonzero {q : ℚ} (hq : q ≠ 0) :
  padic_norm p q = p ^ -padic_val_rat p q :=
by simp [hq, padic_norm]

/-- The `p`-adic norm is nonnegative. -/
protected lemma nonneg (q : ℚ) : 0 ≤ padic_norm p q :=
if hq : q = 0 then by simp [hq, padic_norm]
else
  begin
    unfold padic_norm; split_ifs,
    apply zpow_nonneg,
    exact_mod_cast nat.zero_le _
  end

/-- The `p`-adic norm of `0` is `0`. -/
@[simp] protected lemma zero : padic_norm p 0 = 0 := by simp [padic_norm]

/-- The `p`-adic norm of `1` is `1`. -/
@[simp] protected lemma one : padic_norm p 1 = 1 := by simp [padic_norm]

/-- The `p`-adic norm of `p` is `p⁻¹` if `p > 1`.

See also `padic_norm.padic_norm_p_of_prime` for a version assuming `p` is prime. -/
lemma padic_norm_p (hp : 1 < p) : padic_norm p p = p⁻¹ :=
by simp [padic_norm, (pos_of_gt hp).ne', padic_val_nat.self hp]

/-- The `p`-adic norm of `p` is `p⁻¹` if `p` is prime.

See also `padic_norm.padic_norm_p` for a version assuming `1 < p`. -/
@[simp] lemma padic_norm_p_of_prime [fact p.prime] : padic_norm p p = p⁻¹ :=
padic_norm_p $ nat.prime.one_lt (fact.out _)

/-- The `p`-adic norm of `q` is `1` if `q` is prime and not equal to `p`. -/
lemma padic_norm_of_prime_of_ne {q : ℕ} [p_prime : fact p.prime] [q_prime : fact q.prime]
  (neq : p ≠ q) : padic_norm p q = 1 :=
begin
  have p : padic_val_rat p q = 0,
  { exact_mod_cast @padic_val_nat_primes p q p_prime q_prime neq },
  simp [padic_norm, p, q_prime.1.1, q_prime.1.ne_zero],
end

/-- The `p`-adic norm of `p` is less than `1` if `1 < p`.

See also `padic_norm.padic_norm_p_lt_one_of_prime` for a version assuming `p` is prime. -/
lemma padic_norm_p_lt_one (hp : 1 < p) : padic_norm p p < 1 :=
begin
  rw [padic_norm_p hp, inv_lt_one_iff],
  exact_mod_cast (or.inr hp)
end

/-- The `p`-adic norm of `p` is less than `1` if `p` is prime.

See also `padic_norm.padic_norm_p_lt_one` for a version assuming `1 < p`. -/
lemma padic_norm_p_lt_one_of_prime [fact p.prime] : padic_norm p p < 1 :=
padic_norm_p_lt_one $ nat.prime.one_lt (fact.out _)

/-- `padic_norm p q` takes discrete values `p ^ -z` for `z : ℤ`. -/
protected theorem values_discrete {q : ℚ} (hq : q ≠ 0) : ∃ z : ℤ, padic_norm p q = p ^ -z :=
⟨ (padic_val_rat p q), by simp [padic_norm, hq] ⟩

/-- `padic_norm p` is symmetric. -/
@[simp] protected lemma neg (q : ℚ) : padic_norm p (-q) = padic_norm p q :=
if hq : q = 0 then by simp [hq]
else by simp [padic_norm, hq]

variable [hp : fact p.prime]
include hp

/-- If `q ≠ 0`, then `padic_norm p q ≠ 0`. -/
protected lemma nonzero {q : ℚ} (hq : q ≠ 0) : padic_norm p q ≠ 0 :=
begin
  rw padic_norm.eq_zpow_of_nonzero hq,
  apply zpow_ne_zero_of_ne_zero,
  exact_mod_cast ne_of_gt hp.1.pos
end

/-- If the `p`-adic norm of `q` is 0, then `q` is `0`. -/
lemma zero_of_padic_norm_eq_zero {q : ℚ} (h : padic_norm p q = 0) : q = 0 :=
begin
  apply by_contradiction, intro hq,
  unfold padic_norm at h, rw if_neg hq at h,
  apply absurd h,
  apply zpow_ne_zero_of_ne_zero,
  exact_mod_cast hp.1.ne_zero
end

/-- The `p`-adic norm is multiplicative. -/
@[simp] protected theorem mul (q r : ℚ) : padic_norm p (q * r) = padic_norm p q * padic_norm p r :=
if hq : q = 0 then
  by simp [hq]
else if hr : r = 0 then
  by simp [hr]
else
  have q * r ≠ 0, from mul_ne_zero hq hr,
  have (p : ℚ) ≠ 0, by simp [hp.1.ne_zero],
  by simp [padic_norm, *, padic_val_rat.mul, zpow_add₀ this, mul_comm]

/-- The `p`-adic norm respects division. -/
@[simp] protected theorem div (q r : ℚ) : padic_norm p (q / r) = padic_norm p q / padic_norm p r :=
if hr : r = 0 then by simp [hr] else
eq_div_of_mul_eq (padic_norm.nonzero hr) (by rw [←padic_norm.mul, div_mul_cancel _ hr])

/-- The `p`-adic norm of an integer is at most `1`. -/
protected theorem of_int (z : ℤ) : padic_norm p z ≤ 1 :=
if hz : z = 0 then by simp [hz, zero_le_one] else
begin
  unfold padic_norm,
  rw [if_neg _],
  { refine zpow_le_one_of_nonpos _ _,
    { exact_mod_cast le_of_lt hp.1.one_lt },
    { rw [padic_val_rat.of_int, neg_nonpos],
      norm_cast, simp }},
  exact_mod_cast hz,
end

private lemma nonarchimedean_aux {q r : ℚ} (h : padic_val_rat p q ≤ padic_val_rat p r) :
  padic_norm p (q + r) ≤ max (padic_norm p q) (padic_norm p r) :=
have hnqp : padic_norm p q ≥ 0, from padic_norm.nonneg _,
have hnrp : padic_norm p r ≥ 0, from padic_norm.nonneg _,
if hq : q = 0 then
  by simp [hq, max_eq_right hnrp, le_max_right]
else if hr : r = 0 then
  by simp [hr, max_eq_left hnqp, le_max_left]
else if hqr : q + r = 0 then
  le_trans (by simpa [hqr] using hnqp) (le_max_left _ _)
else
  begin
    unfold padic_norm, split_ifs,
    apply le_max_iff.2,
    left,
    apply zpow_le_of_le,
    { exact_mod_cast le_of_lt hp.1.one_lt },
    { apply neg_le_neg,
      have : padic_val_rat p q =
              min (padic_val_rat p q) (padic_val_rat p r),
        from (min_eq_left h).symm,
      rw this,
      apply min_le_padic_val_rat_add; assumption }
  end

/-- The `p`-adic norm is nonarchimedean: the norm of `p + q` is at most the max of the norm of `p`
and the norm of `q`. -/
protected theorem nonarchimedean {q r : ℚ} :
  padic_norm p (q + r) ≤ max (padic_norm p q) (padic_norm p r) :=
begin
  wlog hle : (padic_val_rat p q) ≤ (padic_val_rat p r) generalizing q r,
  { rw [add_comm, max_comm], exact this (le_of_not_le hle) },
  exact nonarchimedean_aux hle
end

/-- The `p`-adic norm respects the triangle inequality: the norm of `p + q` is at most the norm of
`p` plus the norm of `q`. -/
theorem triangle_ineq (q r : ℚ) : padic_norm p (q + r) ≤ padic_norm p q + padic_norm p r :=
calc padic_norm p (q + r) ≤ max (padic_norm p q) (padic_norm p r) : padic_norm.nonarchimedean
                       ... ≤ padic_norm p q + padic_norm p r :
                         max_le_add_of_nonneg (padic_norm.nonneg _) (padic_norm.nonneg _)

/-- The `p`-adic norm of a difference is at most the max of each component. Restates the archimedean
property of the `p`-adic norm. -/
protected theorem sub {q r : ℚ} : padic_norm p (q - r) ≤ max (padic_norm p q) (padic_norm p r) :=
by rw [sub_eq_add_neg, ←padic_norm.neg r]; apply padic_norm.nonarchimedean

/-- If the `p`-adic norms of `q` and `r` are different, then the norm of `q + r` is equal to the max
of the norms of `q` and `r`. -/
lemma add_eq_max_of_ne {q r : ℚ} (hne : padic_norm p q ≠ padic_norm p r) :
  padic_norm p (q + r) = max (padic_norm p q) (padic_norm p r) :=
begin
  wlog hlt : (padic_norm p r) < (padic_norm p q),
  { rw [add_comm, max_comm], exact this hne.symm (hne.lt_or_lt.resolve_right hlt) },
  have : padic_norm p q ≤ max (padic_norm p (q + r)) (padic_norm p r), from calc
   padic_norm p q = padic_norm p (q + r - r) : by congr; ring
               ... ≤ max (padic_norm p (q + r)) (padic_norm p (-r)) : padic_norm.nonarchimedean
               ... = max (padic_norm p (q + r)) (padic_norm p r) : by simp,
  have hnge : padic_norm p r ≤ padic_norm p (q + r),
  { apply le_of_not_gt,
    intro hgt,
    rw max_eq_right_of_lt hgt at this,
    apply not_lt_of_ge this,
    assumption },
  have : padic_norm p q ≤ padic_norm p (q + r), by rwa [max_eq_left hnge] at this,
  apply _root_.le_antisymm,
  { apply padic_norm.nonarchimedean },
  { rwa max_eq_left_of_lt hlt }
end

/-- The `p`-adic norm is an absolute value: positive-definite and multiplicative, satisfying the
triangle inequality. -/
instance : is_absolute_value (padic_norm p) :=
{ abv_nonneg := padic_norm.nonneg,
  abv_eq_zero := λ _, ⟨zero_of_padic_norm_eq_zero, λ hx, by simpa only [hx]⟩,
  abv_add := padic_norm.triangle_ineq,
  abv_mul := padic_norm.mul }

lemma dvd_iff_norm_le {n : ℕ} {z : ℤ} : ↑(p ^ n) ∣ z ↔ padic_norm p z ≤ p ^ (-n : ℤ) :=
begin
  unfold padic_norm, split_ifs with hz,
  { norm_cast at hz,
    have : 0 ≤ (p ^ n : ℚ), {apply pow_nonneg, exact_mod_cast le_of_lt hp.1.pos },
    simp [hz, this] },
  { rw [zpow_le_iff_le, neg_le_neg_iff, padic_val_rat.of_int,
      padic_val_int.of_ne_one_ne_zero hp.1.ne_one _],
    { norm_cast,
      rw [← part_enat.coe_le_coe, part_enat.coe_get, ← multiplicity.pow_dvd_iff_le_multiplicity],
      simp },
    { exact_mod_cast hz },
    { exact_mod_cast hp.1.one_lt } }
end

/-- The `p`-adic norm of an integer `m` is one iff `p` doesn't divide `m`. -/
lemma int_eq_one_iff (m : ℤ) : padic_norm p m = 1 ↔ ¬ (p : ℤ) ∣ m :=
begin
  nth_rewrite 1 ← pow_one p,
  simp only [dvd_iff_norm_le, int.cast_coe_nat, nat.cast_one, zpow_neg, zpow_one, not_le],
  split,
  { intro h,
    rw [h, inv_lt_one_iff_of_pos];
    norm_cast,
    { exact nat.prime.one_lt (fact.out _), },
    { exact nat.prime.pos (fact.out _), }, },
  { simp only [padic_norm],
    split_ifs,
    { rw [inv_lt_zero, ← nat.cast_zero, nat.cast_lt],
      intro h, exact (nat.not_lt_zero p h).elim, },
    { have : 1 < (p : ℚ) := by norm_cast; exact (nat.prime.one_lt (fact.out _ : nat.prime p)),
      rw [← zpow_neg_one, zpow_lt_iff_lt this],
      have : 0 ≤ padic_val_rat p m, simp only [of_int, nat.cast_nonneg],
      intro h,
      rw [← zpow_zero (p : ℚ), zpow_inj];
      linarith, } },
end

lemma int_lt_one_iff (m : ℤ) : padic_norm p m < 1 ↔ (p : ℤ) ∣ m :=
begin
  rw [← not_iff_not, ← int_eq_one_iff, eq_iff_le_not_lt],
  simp only [padic_norm.of_int, true_and],
end

lemma of_nat (m : ℕ) : padic_norm p m ≤ 1 := padic_norm.of_int (m : ℤ)

/-- The `p`-adic norm of a natural `m` is one iff `p` doesn't divide `m`. -/
lemma nat_eq_one_iff (m : ℕ) : padic_norm p m = 1 ↔ ¬ p ∣ m :=
by simp only [←int.coe_nat_dvd, ←int_eq_one_iff, int.cast_coe_nat]

lemma nat_lt_one_iff (m : ℕ) : padic_norm p m < 1 ↔ p ∣ m :=
by simp only [←int.coe_nat_dvd, ←int_lt_one_iff, int.cast_coe_nat]

open_locale big_operators

lemma sum_lt {α : Type*} {F : α → ℚ} {t : ℚ} {s : finset α} :
  s.nonempty → (∀ i ∈ s, padic_norm p (F i) < t) → padic_norm p (∑ i in s, F i) < t :=
begin
  classical,
  refine s.induction_on (by { rintro ⟨-, ⟨⟩⟩, }) _,
  rintro a S haS IH - ht,
  by_cases hs : S.nonempty,
  { rw finset.sum_insert haS,
    exact lt_of_le_of_lt padic_norm.nonarchimedean (max_lt
      (ht a (finset.mem_insert_self a S))
      (IH hs (λ b hb, ht b (finset.mem_insert_of_mem hb)))), },
  { simp * at *, },
end

lemma sum_le {α : Type*} {F : α → ℚ} {t : ℚ} {s : finset α} :
  s.nonempty → (∀ i ∈ s, padic_norm p (F i) ≤ t) → padic_norm p (∑ i in s, F i) ≤ t :=
begin
  classical,
  refine s.induction_on (by { rintro ⟨-, ⟨⟩⟩, }) _,
  rintro a S haS IH - ht,
  by_cases hs : S.nonempty,
  { rw finset.sum_insert haS,
    exact padic_norm.nonarchimedean.trans (max_le
      (ht a (finset.mem_insert_self a S))
      (IH hs (λ b hb, ht b (finset.mem_insert_of_mem hb)))), },
  { simp * at *, },
end

lemma sum_lt' {α : Type*} {F : α → ℚ} {t : ℚ} {s : finset α} (hF : ∀ i ∈ s, padic_norm p (F i) < t)
  (ht : 0 < t) : padic_norm p (∑ i in s, F i) < t :=
begin
  obtain rfl | hs := finset.eq_empty_or_nonempty s,
  { simp [ht], },
  { exact sum_lt hs hF, },
end

lemma sum_le' {α : Type*} {F : α → ℚ} {t : ℚ} {s : finset α} (hF : ∀ i ∈ s, padic_norm p (F i) ≤ t)
  (ht : 0 ≤ t) : padic_norm p (∑ i in s, F i) ≤ t :=
begin
  obtain rfl | hs := finset.eq_empty_or_nonempty s,
  { simp [ht], },
  { exact sum_le hs hF, },
end

end padic_norm


import data.real.basic
import topology.basic
open function
open set

namespace xena -- hide

/-
# Chapter 7 : Cardinality

## Level 3

A classical result about countable sets.
-/

/- Lemma
If $f : X \to Y$ is an injective function and $Y$ is countable, then
$X$ is also countable.
-/
theorem countable_inj (X Y : set ℝ) (f : X → Y) (hY : countable Y) :
    injective f → countable X :=
begin
   intro hf,
    have H := countable_iff_exists_injective.1 hY,
    cases H with g hg,
    have G := countable_iff_exists_injective.2 ⟨g ∘ f, injective.comp hg hf⟩,
    exact G, done
end

end xena -- hide

-- begin hide
-- term mode proof due to Kenny Lau
theorem countable_inj_2 (X Y : set ℝ) (f : X → Y) (hY : countable Y) :
    injective f → countable X :=
λ hf, let ⟨g, hg⟩ := countable_iff_exists_injective.1 hY in
countable_iff_exists_injective.2 ⟨g ∘ f, injective.comp hg hf⟩
-- end hide


/-
Copyright (c) 2020 Anatole Dedecker. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Anatole Dedecker, Alexey Soloyev, Junyan Xu
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.real.irrational
import Mathlib.data.nat.fib
import Mathlib.data.matrix.notation
import Mathlib.tactic.ring_exp
import Mathlib.algebra.linear_recurrence
import Mathlib.PostPort

universes u_1

namespace Mathlib

/-!
# The golden ratio and its conjugate

This file defines the golden ratio `φ := (1 + √5)/2` and its conjugate
`ψ := (1 - √5)/2`, which are the two real roots of `X² - X - 1`.

Along with various computational facts about them, we prove their
irrationality, and we link them to the Fibonacci sequence by proving
Binet's formula.
-/

/-- The golden ratio `φ := (1 + √5)/2`. -/
def golden_ratio : ℝ :=
  (1 + real.sqrt (bit1 (bit0 1))) / bit0 1

/-- The conjugate of the golden ratio `ψ := (1 - √5)/2`. -/
def golden_conj : ℝ :=
  (1 - real.sqrt (bit1 (bit0 1))) / bit0 1

/-- The inverse of the golden ratio is the opposite of its conjugate. -/
theorem inv_gold : golden_ratio⁻¹ = -golden_conj := sorry

/-- The opposite of the golden ratio is the inverse of its conjugate. -/
theorem inv_gold_conj : golden_conj⁻¹ = -golden_ratio := sorry

@[simp] theorem gold_mul_gold_conj : golden_ratio * golden_conj = -1 := sorry

@[simp] theorem gold_conj_mul_gold : golden_conj * golden_ratio = -1 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (golden_conj * golden_ratio = -1)) (mul_comm golden_conj golden_ratio)))
    gold_mul_gold_conj

@[simp] theorem gold_add_gold_conj : golden_ratio + golden_conj = 1 := sorry

theorem one_sub_gold_conj : 1 - golden_ratio = golden_conj := sorry

theorem one_sub_gold : 1 - golden_conj = golden_ratio := sorry

@[simp] theorem gold_sub_gold_conj : golden_ratio - golden_conj = real.sqrt (bit1 (bit0 1)) := sorry

@[simp] theorem gold_sq : golden_ratio ^ bit0 1 = golden_ratio + 1 := sorry

@[simp] theorem gold_conj_sq : golden_conj ^ bit0 1 = golden_conj + 1 := sorry

theorem gold_pos : 0 < golden_ratio := sorry

theorem gold_ne_zero : golden_ratio ≠ 0 :=
  ne_of_gt gold_pos

theorem one_lt_gold : 1 < golden_ratio := sorry

theorem gold_conj_neg : golden_conj < 0 := sorry

theorem gold_conj_ne_zero : golden_conj ≠ 0 :=
  ne_of_lt gold_conj_neg

theorem neg_one_lt_gold_conj : -1 < golden_conj :=
  eq.mpr (id (Eq._oldrec (Eq.refl (-1 < golden_conj)) (propext neg_lt)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (-golden_conj < 1)) (Eq.symm inv_gold))) (inv_lt_one one_lt_gold))

/-!
## Irrationality
-/

/-- The golden ratio is irrational. -/
theorem gold_irrational : irrational golden_ratio := sorry

/-- The conjugate of the golden ratio is irrational. -/
theorem gold_conj_irrational : irrational golden_conj := sorry

/-!
## Links with Fibonacci sequence
-/

/-- The recurrence relation satisfied by the Fibonacci sequence. -/
def fib_rec {α : Type u_1} [comm_semiring α] : linear_recurrence α :=
  linear_recurrence.mk (bit0 1) (matrix.vec_cons 1 (matrix.vec_cons 1 matrix.vec_empty))

/-- The characteristic polynomial of `fib_rec` is `X² - (X + 1)`. -/
theorem fib_rec_char_poly_eq {β : Type u_1} [comm_ring β] : linear_recurrence.char_poly fib_rec = polynomial.X ^ bit0 1 - (polynomial.X + 1) := sorry

/-- As expected, the Fibonacci sequence is a solution of `fib_rec`. -/
theorem fib_is_sol_fib_rec {α : Type u_1} [comm_semiring α] : linear_recurrence.is_solution fib_rec fun (x : ℕ) => ↑(nat.fib x) := sorry

/-- The geometric sequence `λ n, φ^n` is a solution of `fib_rec`. -/
theorem geom_gold_is_sol_fib_rec : linear_recurrence.is_solution fib_rec (pow golden_ratio) := sorry

/-- The geometric sequence `λ n, ψ^n` is a solution of `fib_rec`. -/
theorem geom_gold_conj_is_sol_fib_rec : linear_recurrence.is_solution fib_rec (pow golden_conj) := sorry

/-- Binet's formula as a function equality. -/
theorem real.coe_fib_eq' : (fun (n : ℕ) => ↑(nat.fib n)) = fun (n : ℕ) => (golden_ratio ^ n - golden_conj ^ n) / real.sqrt (bit1 (bit0 1)) := sorry

/-- Binet's formula as a dependent equality. -/
theorem real.coe_fib_eq (n : ℕ) : ↑(nat.fib n) = (golden_ratio ^ n - golden_conj ^ n) / real.sqrt (bit1 (bit0 1)) := sorry


-- different versions of one proof in tactic mode

-- proofs with the or connective
example (p q : Prop) : p ∨ q → q ∨ p := by
intro h
apply Or.elim h
intro hp
exact Or.intro_right q hp
intro hq
exact Or.intro_left p hq

example (p q : Prop) : p ∨ q → q ∨ p := by
intro h
cases h
apply Or.intro_right
assumption
apply Or.intro_left
assumption

example (p q : Prop) : p ∨ q → q ∨ p := by
intro h
cases h with
  | inl hp => apply Or.intro_right
              exact hp
  | inr hq => apply Or.intro_left
              exact hq

example (p q : Prop) : p ∨ q → q ∨ p := by
intro h
cases h with
  | inl => apply Or.intro_right
           assumption
  | inr => apply Or.intro_left
           assumption

-- proofs with the and connective

example (p q : Prop) : p ∧ q → q ∧ p := by
intro h
apply And.intro
exact h.right
exact h.left

example (p q : Prop) : p ∧ q → q ∧ p := by
intro h
cases h
apply And.intro
repeat assumption

example (p q : Prop) : p ∧ q → q ∧ p := by
intro h
cases h with
| intro hp hq => exact (And.intro hq hp)

example (p q : Prop) : p ∧ q → q ∧ p := by
intro h
cases h with
| intro => apply And.intro
           repeat assumption

example (p q : Prop) : p ∧ q → q ∧ p :=
fun h => And.intro h.right h.left


/-
Copyright (c) 2020 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov, Eric Wieser
-/
import algebra.quaternion
import analysis.inner_product_space.basic
import analysis.inner_product_space.pi_L2
import topology.algebra.algebra

/-!
# Quaternions as a normed algebra

In this file we define the following structures on the space `ℍ := ℍ[ℝ]` of quaternions:

* inner product space;
* normed ring;
* normed space over `ℝ`.

We show that the norm on `ℍ[ℝ]` agrees with the euclidean norm of its components.

## Notation

The following notation is available with `open_locale quaternion`:

* `ℍ` : quaternions

## Tags

quaternion, normed ring, normed space, normed algebra
-/

localized "notation (name := quaternion.real) `ℍ` := quaternion ℝ" in quaternion
open_locale real_inner_product_space

namespace quaternion

instance : has_inner ℝ ℍ := ⟨λ a b, (a * b.conj).re⟩

lemma inner_self (a : ℍ) : ⟪a, a⟫ = norm_sq a := rfl

lemma inner_def (a b : ℍ) : ⟪a, b⟫ = (a * b.conj).re := rfl

noncomputable instance : normed_add_comm_group ℍ :=
@inner_product_space.of_core.to_normed_add_comm_group ℝ ℍ _ _ _
{ inner := has_inner.inner,
  conj_symm := λ x y, by simp [inner_def, mul_comm],
  nonneg_re := λ x, norm_sq_nonneg,
  definite := λ x, norm_sq_eq_zero.1,
  add_left := λ x y z, by simp only [inner_def, add_mul, add_re],
  smul_left := λ x y r, by simp [inner_def] }

noncomputable instance : inner_product_space ℝ ℍ :=
inner_product_space.of_core _

lemma norm_sq_eq_norm_sq (a : ℍ) : norm_sq a = ‖a‖ * ‖a‖ :=
by rw [← inner_self, real_inner_self_eq_norm_mul_norm]

instance : norm_one_class ℍ :=
⟨by rw [norm_eq_sqrt_real_inner, inner_self, norm_sq.map_one, real.sqrt_one]⟩

@[simp, norm_cast] lemma norm_coe (a : ℝ) : ‖(a : ℍ)‖ = ‖a‖ :=
by rw [norm_eq_sqrt_real_inner, inner_self, norm_sq_coe, real.sqrt_sq_eq_abs, real.norm_eq_abs]

@[simp, norm_cast] lemma nnnorm_coe (a : ℝ) : ‖(a : ℍ)‖₊ = ‖a‖₊ :=
subtype.ext $ norm_coe a

@[simp] lemma norm_conj (a : ℍ) : ‖conj a‖ = ‖a‖ :=
by simp_rw [norm_eq_sqrt_real_inner, inner_self, norm_sq_conj]

@[simp] lemma nnnorm_conj (a : ℍ) : ‖conj a‖₊ = ‖a‖₊ :=
subtype.ext $ norm_conj a

noncomputable instance : normed_division_ring ℍ :=
{ dist_eq := λ _ _, rfl,
  norm_mul' := λ a b, by { simp only [norm_eq_sqrt_real_inner, inner_self, norm_sq.map_mul],
                           exact real.sqrt_mul norm_sq_nonneg _ } }

instance : normed_algebra ℝ ℍ :=
{ norm_smul_le := norm_smul_le,
  to_algebra := (quaternion.algebra : algebra ℝ ℍ) }

instance : cstar_ring ℍ :=
{ norm_star_mul_self := λ x, (norm_mul _ _).trans $ congr_arg (* ‖x‖) (norm_conj x) }

instance : has_coe ℂ ℍ := ⟨λ z, ⟨z.re, z.im, 0, 0⟩⟩

@[simp, norm_cast]

@[simp, norm_cast] lemma coe_complex_add (z w : ℂ) : ↑(z + w) = (z + w : ℍ) := by ext; simp
@[simp, norm_cast] lemma coe_complex_mul (z w : ℂ) : ↑(z * w) = (z * w : ℍ) := by ext; simp
@[simp, norm_cast] lemma coe_complex_zero : ((0 : ℂ) : ℍ) = 0 := rfl
@[simp, norm_cast] lemma coe_complex_one : ((1 : ℂ) : ℍ) = 1 := rfl
@[simp, norm_cast] lemma coe_real_complex_mul (r : ℝ) (z : ℂ) : (r • z : ℍ) = ↑r * ↑z :=
by ext; simp
@[simp, norm_cast] lemma coe_complex_coe (r : ℝ) : ((r : ℂ) : ℍ) = r := rfl

/-- Coercion `ℂ →ₐ[ℝ] ℍ` as an algebra homomorphism. -/
def of_complex : ℂ →ₐ[ℝ] ℍ :=
{ to_fun := coe,
  map_one' := rfl,
  map_zero' := rfl,
  map_add' := coe_complex_add,
  map_mul' := coe_complex_mul,
  commutes' := λ x, rfl }

@[simp] lemma coe_of_complex : ⇑of_complex = coe := rfl

/-- The norm of the components as a euclidean vector equals the norm of the quaternion. -/
lemma norm_pi_Lp_equiv_symm_equiv_tuple (x : ℍ) :
  ‖(pi_Lp.equiv 2 (λ _ : fin 4, _)).symm (equiv_tuple ℝ x)‖ = ‖x‖ :=
begin
  rw [norm_eq_sqrt_real_inner, norm_eq_sqrt_real_inner, inner_self, norm_sq_def', pi_Lp.inner_apply,
    fin.sum_univ_four],
  simp_rw [is_R_or_C.inner_apply, star_ring_end_apply, star_trivial, ←sq],
  refl,
end

/-- `quaternion_algebra.linear_equiv_tuple` as a `linear_isometry_equiv`. -/
@[simps apply symm_apply]
noncomputable def linear_isometry_equiv_tuple : ℍ ≃ₗᵢ[ℝ] euclidean_space ℝ (fin 4) :=
{ to_fun := λ a, (pi_Lp.equiv _ (λ _ : fin 4, _)).symm ![a.1, a.2, a.3, a.4],
  inv_fun := λ a, ⟨a 0, a 1, a 2, a 3⟩,
  norm_map' := norm_pi_Lp_equiv_symm_equiv_tuple,
  ..(quaternion_algebra.linear_equiv_tuple (-1 : ℝ) (-1 : ℝ)).trans
      (pi_Lp.linear_equiv 2 ℝ (λ _ : fin 4, ℝ)).symm }

@[continuity] lemma continuous_conj : continuous (conj : ℍ → ℍ) :=
continuous_star

@[continuity] lemma continuous_coe : continuous (coe : ℝ → ℍ) :=
continuous_algebra_map ℝ ℍ

@[continuity] lemma continuous_norm_sq : continuous (norm_sq : ℍ → ℝ) :=
by simpa [←norm_sq_eq_norm_sq]
  using (continuous_norm.mul continuous_norm : continuous (λ q : ℍ, ‖q‖ * ‖q‖))

@[continuity] lemma continuous_re : continuous (λ q : ℍ, q.re) :=
(continuous_apply 0).comp linear_isometry_equiv_tuple.continuous

@[continuity] lemma continuous_im_i : continuous (λ q : ℍ, q.im_i) :=
(continuous_apply 1).comp linear_isometry_equiv_tuple.continuous

@[continuity] lemma continuous_im_j : continuous (λ q : ℍ, q.im_j) :=
(continuous_apply 2).comp linear_isometry_equiv_tuple.continuous

@[continuity] lemma continuous_im_k : continuous (λ q : ℍ, q.im_k) :=
(continuous_apply 3).comp linear_isometry_equiv_tuple.continuous

@[continuity] lemma continuous_im : continuous (λ q : ℍ, q.im) :=
by simpa only [←sub_self_re] using continuous_id.sub (continuous_coe.comp continuous_re)

instance : complete_space ℍ :=
begin
  have : uniform_embedding linear_isometry_equiv_tuple.to_linear_equiv.to_equiv.symm :=
    linear_isometry_equiv_tuple.to_continuous_linear_equiv.symm.uniform_embedding,
  exact (complete_space_congr this).1 (by apply_instance)
end

section infinite_sum
variables {α : Type*}

@[simp, norm_cast] lemma has_sum_coe {f : α → ℝ} {r : ℝ} :
  has_sum (λ a, (f a : ℍ)) (↑r : ℍ) ↔ has_sum f r :=
⟨λ h, by simpa only using
  h.map (show ℍ →ₗ[ℝ] ℝ, from quaternion_algebra.re_lm _ _) continuous_re,
  λ h, by simpa only using h.map (algebra_map ℝ ℍ) (continuous_algebra_map _ _)⟩

@[simp, norm_cast]
lemma summable_coe {f : α → ℝ} : summable (λ a, (f a : ℍ)) ↔ summable f :=
by simpa only using summable.map_iff_of_left_inverse (algebra_map ℝ ℍ)
  (show ℍ →ₗ[ℝ] ℝ, from quaternion_algebra.re_lm _ _)
  (continuous_algebra_map _ _) continuous_re coe_re

@[norm_cast] lemma tsum_coe (f : α → ℝ) : ∑' a, (f a : ℍ) = ↑(∑' a, f a) :=
begin
  by_cases hf : summable f,
  { exact (has_sum_coe.mpr hf.has_sum).tsum_eq, },
  { simp [tsum_eq_zero_of_not_summable hf,
      tsum_eq_zero_of_not_summable (summable_coe.not.mpr hf)] },
end

end infinite_sum

end quaternion


/- Lecture 1.3: Basics — More Logic and Proofs -/

/- Logical connectives and quantifiers -/

-- introduction rules
#check true.intro
#check not.intro
#check and.intro
#check or.intro_left
#check or.intro_right
#check iff.intro
#check exists.intro

-- elimination rules
#check false.elim
#check and.elim_left
#check and.elim_right
#check or.elim
#check exists.elim

-- aliases
#check and.left
#check and.right

-- definition of `¬` and related lemmas
#print not
#check classical.em
#check classical.by_contradiction

example (p q : Prop) : p ∧ q → p := and.elim_left

example (p q : Prop) : p ∧ q → q ∧ p :=
assume hpq : p ∧ q,
have hp : p := and.left hpq,
have hq : q := and.right hpq,
show q ∧ p, from and.intro hq hp

-- conjunction (`and`)

example (p q : Prop) : p ∧ q → q ∧ p :=
λhpq : p ∧ q,
  (λhp : p,
    (λhq : q,
      (and.intro hq hp : q ∧ p))
    (and.right hpq))
  (and.left hpq)

example : ∀p q : Prop, p ∧ q → q ∧ p :=
begin
  intros _ _ hpq,
  exact and.intro (and.right hpq) (and.left hpq)
end

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

example : ∀p q : Prop, p ∧ q → q ∧ p :=
begin
  intros _ _ hpq,
  apply and.intro,
  exact hpq.right,
  exact hpq.left
end

-- disjunction (`or`)

example (p q : Prop) : p ∨ q → q ∨ p
| (or.inl h) := or.inr h
| (or.inr h) := or.inl h

example (p q : Prop) : p ∨ q → q ∨ p :=
begin
  intros hpq,
  apply (or.elim hpq),
  { intros h, apply or.inr h },
  { intros h, apply or.inl h }
end

-- implication (`imp`)

example (p q : Prop) : p → q → p :=
assume hp hq,
show p, from hp

-- modus ponens (elimination of implication)

example (p q : Prop) (h : p → q) (hp : p) : q :=
h hp

example (p q : Prop) (h : p → q) (hp : p) : q :=
begin
  apply h,
  exact hp
end

example (p q : Prop) (h : p → q) (hp : p) : q :=
begin
  apply h,
  assumption
end

-- proof of negation

example (p : Prop) : p → ¬¬ p :=
begin
  dunfold not,
  intro hp,
  apply not.intro,
  intro hnp,
  apply hnp,
  exact hp
end

example (p : Prop) : p → ¬¬ p :=
begin
  intros hp hnp,
  refine hnp _,
  exact hp
end

-- proof by contradiction

example (p : Prop) : ¬¬ p → p :=
begin
  intro hnnp,
  apply classical.by_contradiction,
  apply hnnp
end

example (p : Prop) : ¬¬ p → p :=
begin
  intro,
  apply classical.by_contradiction,
  assumption
end

/- Arithmetic calculations -/

-- `#mul` in Visual Studio Code's command palette
#check two_mul

example (m n : ℕ) : 2 * m + n = m + n + m :=
calc 2 * m + n = (m + m) + n : by rw two_mul
... = m + n + m : by ac_refl


import ..prooflab
import lectures.lec18_nat_trans
import tactic.basic

--open PROOFS
open PROOFS.STR

open category_str

--Q1
--Let's do this for additive groups. multiplicative groups are basically the same
--We have defined the type of additve groups
#check additive_Group

universe u
--we need to define the morphism between additive groups
--let's define it like we did for additive_monoid
@[ext]
class additive_monoid.morphism (M : Type u) (N : Type u) [additive_monoid_str M] [additive_monoid_str N] :=
(to_fun : M → N) -- f : M → N -- the underlying function of morphism
(resp_zero : to_fun 0 = 0) -- f (1_M ) = 1_N
(resp_add : ∀ x y : M, to_fun (x + y) = to_fun x + to_fun y) -- f(x *_M y) = (f x) *_N (f y)

@[ext]
class additive_group.morphism (M : Type u) (N : Type u) [additive_group_str M] [additive_group_str N] :=
(to_fun : M → N) -- f : M → N -- the underlying function of morphism
(resp_zero : to_fun 0 = 0) -- f (1_M ) = 1_N
(resp_add : ∀ x y : M, to_fun (x + y) = to_fun x + to_fun y) -- f(x *_M y) = (f x) *_N (f y)

--let's also define identity
def additive_group.morphism.id {M : Type}[additive_group_str M] : additive_group.morphism M M :=
{
  to_fun := id, --just identity
  resp_zero := by {simp}, --simplify by previous lemmas
  resp_add := by {simp}, --same here
}

--we also need composition
@[simp]
def additive_group.morphism.comp {L M N : Type} [additive_group_str L] [additive_group_str M] [additive_group_str N] (g : additive_group.morphism M N) (f : additive_group.morphism L M) : additive_group.morphism L N :=
{ to_fun := g.to_fun ∘ f.to_fun, --compose the to_funs
  resp_zero := by
  {
    dsimp, --simplify by definition
    rw f.resp_zero, --use the individual properties of the morphisms to get to the goal
    rw g.resp_zero,
  },
  resp_add := by
  {
    intros x y, --introduction for ∀
    dsimp, --simplfy by definition
    rw f.resp_add, --again, rewrite using individual properties
    rw g.resp_add,
  },
  }

--let's prove id_comp comp_id, and comp_assoc

--id_comp
@[simp]
lemma additive_group.morphism.id_comp {L M : Type} [additive_group_str L] [additive_group_str M]  (f : additive_group.morphism L M)  :
  additive_group.morphism.comp additive_group.morphism.id f = f :=
begin
  ext, --apply extensionality
  refl, --lhs is exactly rhs
end

--comp_id
@[simp]
lemma additive_group.morphism.comp_id {L M : Type} [additive_group_str L] [additive_group_str M]  (f : additive_group.morphism L M)  :
  additive_group.morphism.comp f additive_group.morphism.id = f :=
begin
  ext, --apply extensionality
  refl, --lhs is exactly rhs
end

--comp_assoc
@[simp]
def additive_group.morphism.comp_assoc {K L M N: Type} [additive_group_str K] [additive_group_str L] [additive_group_str M] [additive_group_str N] (f : additive_group.morphism K L) (g : additive_group.morphism L M) (h : additive_group.morphism M N) :
  additive_group.morphism.comp (additive_group.morphism.comp h g) f = additive_group.morphism.comp h (additive_group.morphism.comp g f) :=
begin
  refl, --after simplifcation lhs is exactly rhs
end

instance cat_of_additive_groups : large_category_str (additive_Group) :=
{ hom := λ X Y, additive_group.morphism X.carrier Y.carrier, --morphisms are additive_group.morphisms
  id := λ X, additive_group.morphism.id, --identiy is identity
  comp := λ X Y Z f g, additive_group.morphism.comp g f, --composition is defined above
  id_comp' := by {intros X Y f, apply additive_group.morphism.id_comp}, --proved above
  comp_id' := by {intros X Y f, apply additive_group.morphism.comp_id}, --proved above
  comp_assoc' := by {intros X Y Z W f g h, apply additive_group.morphism.comp_assoc}, --again, proved above
}

--Q2
@[ext]
class mult_monoid_action (M A : Type) [mult_monoid_str M] :=
(smul : M → A → A) -- the scalar multiplication of `M` on `A`.
(one_smul' : ∀ (x : A), smul (1 : M) x = x)
(mul_smul' : ∀ (r s : M) (x : A),
smul (r * s)  x = smul r (smul s x))

--Show that a monoid action gives rise to a functor from the delooping category of the monoid to the category of types. You can show that by filling in for the sorry placeholder in below.
set_option trace.simp_lemmas true

def delooping_monoid_action (A : Type) [M : mult_Monoid] [mult_monoid_action M.carrier A] : (delooping_cat M).carrier ⥤ Type* :=
{ obj := λ Y, A, --element of delooping monoid to element of type
  mor := λ X Y (m : M.carrier), λ a, mult_monoid_action.smul m a, --map unit morphism to function in A. use the scalar multiplication above to send a : A to the action of m on a (still A)
  resp_id' := by
  {
    intro X, --introduction for ∀
    cases X, --extract the properties of X
    funext, --function extensionality
    apply mult_monoid_action.one_smul', --this is one_mul of the monoid action
  },
  resp_comp' := by
  {
    intros X Y Z f g, --introduction for ∀
    cases X, --extract the properties of X Y Z
    cases Y,
    cases Z,
    simp only [precategory_str.comp], --simplify by how we defined composition
    funext, --function extensionality
    dsimp, --simplify by definition
    rw ← mult_monoid_action.mul_smul', --rw the rhs as defined in mult_monoid_action.mul_smul'
    sorry,
  },
}

--Q3 Yoneda

open nat_trans

local notation f ` ⊚ `:80 g:80 := precategory_str.comp g f    -- type as \oo

universes v₁ v₂ v₃ v₄ u₁ u₂ u₃ u₄

variables {𝓒 : Type u₁} [category_str.{v₁} 𝓒] {𝓓 : Type u₂} [category_str.{v₂} 𝓓]

def Yoneda (X Y : 𝓒) (α : category_str.equiv (ℍom.obj X) (ℍom.obj Y)) :
  category_str.equiv X Y :=
{
  to_mor := α.to_mor.cmpt (op X) (𝟙 X),
  inv_mor := α.inv_mor.cmpt (op Y) (𝟙 Y),
  left_inv := by
  {
    have h₁, from α.inv_mor.naturality (α.to_mor.cmpt (op X) (𝟙 X)),
    simp at h₁,
    cases α,
    cases α_to_mor,
    cases α_inv_mor,
    simp at *,
    sorry,

  },
  right_inv := by
  {
    sorry,
  },
}

--Q4
/-! ## The Arrow Category :
Given a category 𝓒 we want to construct a new category whose objects are morphisms of 𝓒 and whose morphisms are commutative squares in 𝓒.
 -/

-- @[ext]
-- structure arrow_type (𝓒 : Type*) [small_category_str 𝓒] :=
-- (dom : 𝓒)
-- (cod : 𝓒)
-- (arrow : dom ⟶ cod)

-- #check arrow_type

local notation `𝔸𝕣` : 10 := arrow_type

-- @[ext]
-- structure arrow_type_hom {𝓒 : Type*}[small_category_str 𝓒] (α β : 𝔸𝕣 𝓒 ) :=
-- (top : α.dom ⟶ β.dom)
-- (bot : α.cod ⟶ β.cod)
-- (eq : β.arrow ⊚ top = bot ⊚ α.arrow)

-- #check arrow_type_hom

/-
Show that we can equip `𝓒[→]` with the structure of a category where morphisms of 𝓒 and whose morphisms are commutative squares in 𝓒.
-/

--added extensionality to functor and arrow structures.

instance arrow_cat (𝓒 : Type*)[small_category_str 𝓒] : small_category_str (𝔸𝕣 𝓒) :=
{ hom := λ α, λ β, arrow_type_hom α β ,
  id := λ α, ⟨𝟙 α.dom, 𝟙 α.cod, by {simp,}⟩ ,
  comp := by
  {
    intros X Y Z, --introduce X, Y, Z for for all
    intros f g, --introduce f, g for the implication
    cases f, --extract f components
    cases g, --extract g components
    exact
    ⟨
    g_top ⊚ f_top, --composed top is the composition of the top components
    g_bot ⊚ f_bot, --composed bot is the composition of the bottom components
    by
    {
      simp, --simplify by how we defined compostion
      rw ←category_str.comp_assoc, --rewrite with the associativity of composition
      rw g_eq, --rewrite using g_eq
      rw category_str.comp_assoc, --use composition associativity again
      rw f_eq, --we can use f_eq to get the rhs to be the same as the lhs
    }
    ⟩, --done
  },
  id_comp' :=
  by
  {
    intros X Y f, --introduction for ∀
    cases f, --extract f components
    simp, --simplify by previous definitions and lemmas
  }
  ,
  comp_id' :=
  by
  {
    intros X Y f,  --introduction for ∀
    cases f, --extract f components
    simp, --simplify by previous definitions and lemmas
  },
  comp_assoc' :=
  by
  {
    intros W X Y Z f g h, --introduction for ∀
    cases f, --extract f,g,h components
    cases g,
    cases h,
    dsimp, --simplify by definition
    ext, --use extensionality of arrow_type_hom to prove equality
    {--top part
      dsimp, --simplify by definition
      apply category_str.comp_assoc, --this is composition associativity
    },
    {--bottom part
      dsimp, --simplify by definition
      apply category_str.comp_assoc, --again, composition associativity
    },
  }, }

#check category_str.comp_assoc

/-
We shall define two functors form `𝔸𝕣 𝓒` to `𝓒`: `Dom` and `Cod`. `Dom` takes an arrow `f : X ⟶ Y` to its domain `X` and `Cod` takes `f` to `Y`.
-/

def Dom (𝓒 : Type*)[small_category_str 𝓒] :
  (𝔸𝕣 𝓒) ⥤ 𝓒 :=
{ obj := λ α, α.dom,
  mor := λ α β f, f.top, --just the top morphism
  resp_id' := by
  {
    intro X, --introduction for ∀
    cases X, --extract X components
    dsimp, --simplify by definition
    refl, --reflexivity after simplification. the left identiy is the same as the right identity (both X_dom after stuff in lhs ().top)
  },
  resp_comp' := by
  {
    intros X Y Z f g, --introduction for ∀
    cases f, --extract f,g components
    cases g,
    dsimp, --simplify by definition
    refl, --reflexivity after simplification. .top lhs gives you the composition on the rhs
  }
,}

def Cod (𝓒 : Type*)[small_category_str 𝓒] :
  (𝔸𝕣 𝓒) ⥤ 𝓒 :=
{ obj := λ α, α.cod,
  mor := λ α β f, f.bot, --similar to Dom, but we use the bottom morphism this time
  resp_id' := by
  {--the proof will be similar to the proof for Dom
    intro X, --introduction for ∀
    cases X, --extract X components
    dsimp, --simplify by definition
    refl, --reflexivity after simplification. the left identiy is the same as the right identity after taking .bot
  },
  resp_comp' := by
  {
    intros X Y Z f g, --introduction for ∀
    cases f, --extract f,g components
    cases g,
    dsimp, --simplify by definition
    refl, --reflexivity after simplification. .bot lhs gives you the composition on the rhs
  }
,}

/- Theorem:
For functors `F G : 𝓒 ⥤ 𝓓`, the type of natural transformations `F ⟶ G` is equivalent to the type of functors `𝓒 ⥤ 𝔸𝕣 𝓓`  whose composition with `Dom` and `Cod` are equal to `F` and `G` respectively.

Therefore, the arrow category classifies natural transformations.
-/

local notation F ` ⊚⊚ `:80 G:80 := category_str.functor.comp G F

def arrow_cat_classifies_nat_trans {𝓒 𝓓 : Type*}[small_category_str 𝓒] [small_category_str 𝓓] (F G : 𝓒 ⥤ 𝓓) :
fun_equiv (F ⟶ G) ({ H : 𝓒 ⥤ 𝔸𝕣 𝓓 // ( (Dom 𝓓) ⊚⊚ H = F ) ∧ ((Cod 𝓓) ⊚⊚ H = G) })   :=

{ to_fun := λ X,
{
  val :=
          {
            obj := λ α,
            {
              dom := F.obj α,
              cod := G.obj α,
              arrow := by {
                            cases X, --extract X components
                            exact X_cmpt α, --use the object map on α
                          },
            },

            mor := by {
                        intros α β f, --introduction for ∀
                        cases X, --extract X components
                        cases F, --extract F components
                        cases G, --extract G components
                        dsimp at *, --simplify by definitions
                        have h1 := F_mor f, --use the F morphism map on f
                        have h2 := G_mor f, --use the G morphism map on f
                        sorry,
                      },

            resp_id' := _,
            resp_comp' := _
          },
  property :=_,

},

{val :=
  { obj := λ α, { dom := F.obj α, cod := G.obj α, arrow := --object morphisms on α
  by
  {
    cases X, --extract X components
    exact X_cmpt α, --use the object map on α
  },},
  mor := λ α β f, { top := F.map f, bot := G.map f,} --morphisms on f
  resp_id' := _,
  resp_comp' := _ }
,

  inv_fun := _,
  left_inv := _,
  right_inv := _ }

,

  inv_fun := _,
  left_inv := _,
  right_inv := _ }


/-
Copyright (c) 2020 Anatole Dedecker. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Anatole Dedecker
-/
import data.polynomial.eval
import linear_algebra.dimension

/-!
# Linear recurrence

Informally, a "linear recurrence" is an assertion of the form
`∀ n : ℕ, u (n + d) = a 0 * u n + a 1 * u (n+1) + ... + a (d-1) * u (n+d-1)`,
where `u` is a sequence, `d` is the *order* of the recurrence and the `a i`
are its *coefficients*.

In this file, we define the structure `linear_recurrence` so that
`linear_recurrence.mk d a` represents the above relation, and we call
a sequence `u` which verifies it a *solution* of the linear recurrence.

We prove a few basic lemmas about this concept, such as :

* the space of solutions is a submodule of `(ℕ → α)` (i.e a vector space if `α`
  is a field)
* the function that maps a solution `u` to its first `d` terms builds a `linear_equiv`
  between the solution space and `fin d → α`, aka `α ^ d`. As a consequence, two
  solutions are equal if and only if their first `d` terms are equals.
* a geometric sequence `q ^ n` is solution iff `q` is a root of a particular polynomial,
  which we call the *characteristic polynomial* of the recurrence

Of course, although we can inductively generate solutions (cf `mk_sol`), the
interesting part would be to determinate closed-forms for the solutions.
This is currently *not implemented*, as we are waiting for definition and
properties of eigenvalues and eigenvectors.

-/

noncomputable theory
open finset
open_locale big_operators polynomial

/-- A "linear recurrence relation" over a commutative semiring is given by its
  order `n` and `n` coefficients. -/
structure linear_recurrence (α : Type*) [comm_semiring α] := (order : ℕ) (coeffs : fin order → α)

instance (α : Type*) [comm_semiring α] : inhabited (linear_recurrence α) :=
⟨⟨0, default⟩⟩

namespace linear_recurrence

section comm_semiring

variables {α : Type*} [comm_semiring α] (E : linear_recurrence α)

/-- We say that a sequence `u` is solution of `linear_recurrence order coeffs` when we have
  `u (n + order) = ∑ i : fin order, coeffs i * u (n + i)` for any `n`. -/
def is_solution (u : ℕ → α) :=
  ∀ n, u (n + E.order) = ∑ i, E.coeffs i * u (n + i)

/-- A solution of a `linear_recurrence` which satisfies certain initial conditions.
  We will prove this is the only such solution. -/
def mk_sol (init : fin E.order → α) : ℕ → α
| n := if h : n < E.order then init ⟨n, h⟩ else
  ∑ k : fin E.order,
    have n - E.order + k < n :=
    begin
      rw [add_comm, ← add_tsub_assoc_of_le (not_lt.mp h), tsub_lt_iff_left],
      { exact add_lt_add_right k.is_lt n },
      { convert add_le_add (zero_le (k : ℕ)) (not_lt.mp h),
        simp only [zero_add] }
    end,
    E.coeffs k * mk_sol (n - E.order + k)

/-- `E.mk_sol` indeed gives solutions to `E`. -/
lemma is_sol_mk_sol (init : fin E.order → α) : E.is_solution (E.mk_sol init) :=
  λ n, by rw mk_sol; simp

/-- `E.mk_sol init`'s first `E.order` terms are `init`. -/
lemma mk_sol_eq_init (init : fin E.order → α) : ∀ n : fin E.order, E.mk_sol init n = init n :=
  λ n, by { rw mk_sol, simp only [n.is_lt, dif_pos, fin.mk_coe, fin.eta] }

/-- If `u` is a solution to `E` and `init` designates its first `E.order` values,
  then `∀ n, u n = E.mk_sol init n`. -/
lemma eq_mk_of_is_sol_of_eq_init {u : ℕ → α} {init : fin E.order → α}
  (h : E.is_solution u) (heq : ∀ n : fin E.order, u n = init n) :
  ∀ n, u n = E.mk_sol init n
| n := if h' : n < E.order
  then by rw mk_sol; simp only [h', dif_pos]; exact_mod_cast heq ⟨n, h'⟩
  else begin
    rw [mk_sol, ← tsub_add_cancel_of_le (le_of_not_lt h'), h (n-E.order)],
    simp [h'],
    congr' with k,
    exact have wf : n - E.order + k < n :=
      begin
        rw [add_comm, ← add_tsub_assoc_of_le (not_lt.mp h'), tsub_lt_iff_left],
        { exact add_lt_add_right k.is_lt n },
        { convert add_le_add (zero_le (k : ℕ)) (not_lt.mp h'),
          simp only [zero_add] }
      end,
      by rw eq_mk_of_is_sol_of_eq_init
  end

/-- If `u` is a solution to `E` and `init` designates its first `E.order` values,
  then `u = E.mk_sol init`. This proves that `E.mk_sol init` is the only solution
  of `E` whose first `E.order` values are given by `init`. -/
lemma eq_mk_of_is_sol_of_eq_init' {u : ℕ → α} {init : fin E.order → α}
  (h : E.is_solution u) (heq : ∀ n : fin E.order, u n = init n) : u = E.mk_sol init :=
  funext (E.eq_mk_of_is_sol_of_eq_init h heq)

/-- The space of solutions of `E`, as a `submodule` over `α` of the module `ℕ → α`. -/
def sol_space : submodule α (ℕ → α) :=
{ carrier := {u | E.is_solution u},
  zero_mem' := λ n, by simp,
  add_mem' := λ u v hu hv n, by simp [mul_add, sum_add_distrib, hu n, hv n],
  smul_mem' := λ a u hu n, by simp [hu n, mul_sum]; congr'; ext; ac_refl }

/-- Defining property of the solution space : `u` is a solution
  iff it belongs to the solution space. -/
lemma is_sol_iff_mem_sol_space (u : ℕ → α) : E.is_solution u ↔ u ∈ E.sol_space :=
  iff.rfl

/-- The function that maps a solution `u` of `E` to its first
  `E.order` terms as a `linear_equiv`. -/
def to_init :
  E.sol_space ≃ₗ[α] (fin E.order → α) :=
{ to_fun := λ u x, (u : ℕ → α) x,
  map_add' := λ u v, by { ext, simp },
  map_smul' := λ a u, by { ext, simp },
  inv_fun := λ u, ⟨E.mk_sol u, E.is_sol_mk_sol u⟩,
  left_inv := λ u, by ext n; symmetry; apply E.eq_mk_of_is_sol_of_eq_init u.2; intros k; refl,
  right_inv := λ u, function.funext_iff.mpr (λ n, E.mk_sol_eq_init u n) }

/-- Two solutions are equal iff they are equal on `range E.order`. -/
lemma sol_eq_of_eq_init (u v : ℕ → α) (hu : E.is_solution u) (hv : E.is_solution v) :
  u = v ↔ set.eq_on u v ↑(range E.order) :=
begin
  refine iff.intro (λ h x hx, h ▸ rfl) _,
  intro h,
  set u' : ↥(E.sol_space) := ⟨u, hu⟩,
  set v' : ↥(E.sol_space) := ⟨v, hv⟩,
  change u'.val = v'.val,
  suffices h' : u' = v', from h' ▸ rfl,
  rw [← E.to_init.to_equiv.apply_eq_iff_eq, linear_equiv.coe_to_equiv],
  ext x,
  exact_mod_cast h (mem_range.mpr x.2)
end

/-! `E.tuple_succ` maps `![s₀, s₁, ..., sₙ]` to `![s₁, ..., sₙ, ∑ (E.coeffs i) * sᵢ]`,
  where `n := E.order`. This operation is quite useful for determining closed-form
  solutions of `E`. -/

/-- `E.tuple_succ` maps `![s₀, s₁, ..., sₙ]` to `![s₁, ..., sₙ, ∑ (E.coeffs i) * sᵢ]`,
  where `n := E.order`. -/
def tuple_succ : (fin E.order → α) →ₗ[α] (fin E.order → α) :=
{ to_fun := λ X i, if h : (i : ℕ) + 1 < E.order then X ⟨i+1, h⟩ else (∑ i, E.coeffs i * X i),
  map_add' := λ x y,
    begin
      ext i,
      split_ifs ; simp [h, mul_add, sum_add_distrib],
    end,
  map_smul' := λ x y,
    begin
      ext i,
      split_ifs ; simp [h, mul_sum],
      exact sum_congr rfl (λ x _, by ac_refl),
    end }

end comm_semiring

section field

variables {α : Type*} [field α] (E : linear_recurrence α)

/-- The dimension of `E.sol_space` is `E.order`. -/
lemma sol_space_dim : module.rank α E.sol_space = E.order :=
@dim_fin_fun α _ E.order ▸ E.to_init.dim_eq

end field

section comm_ring

variables {α : Type*} [comm_ring α] (E : linear_recurrence α)

/-- The characteristic polynomial of `E` is
`X ^ E.order - ∑ i : fin E.order, (E.coeffs i) * X ^ i`. -/
def char_poly : α[X] :=
  polynomial.monomial E.order 1 - (∑ i : fin E.order, polynomial.monomial i (E.coeffs i))

/-- The geometric sequence `q^n` is a solution of `E` iff
  `q` is a root of `E`'s characteristic polynomial. -/
lemma geom_sol_iff_root_char_poly (q : α) : E.is_solution (λ n, q^n) ↔ E.char_poly.is_root q :=
begin
  rw [char_poly, polynomial.is_root.def, polynomial.eval],
  simp only [polynomial.eval₂_finset_sum, one_mul,
              ring_hom.id_apply, polynomial.eval₂_monomial, polynomial.eval₂_sub],
  split,
  { intro h,
    simpa [sub_eq_zero] using h 0 },
  { intros h n,
    simp only [pow_add, sub_eq_zero.mp h, mul_sum],
    exact sum_congr rfl (λ _ _, by ring) }
end

end comm_ring

end linear_recurrence