/-
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

/-!
# 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`: the multiplicative (resp., additive) closure
  of `{x}` consists of powers (resp., natural multiples) of `x`.

## Tags
submonoid, submonoids
-/

open_locale big_operators

variables {M : Type*}
variables {A : Type*}

namespace submonoid

section assoc
variables [monoid M] (S : submonoid M)

@[simp, norm_cast, to_additive coe_nsmul] theorem coe_pow (x : S) (n : ℕ) :
  ↑(x ^ n) = (x ^ n : M) :=
S.subtype.map_pow x n

@[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 }

/-- 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 nsmul_mem] lemma pow_mem {x : M} (hx : x ∈ S) (n : ℕ) : x ^ n ∈ S :=
by simpa only [coe_pow] using ((⟨x, hx⟩ : S) ^ n).coe_prop

end assoc

section non_assoc
variables [mul_one_class M] (S : submonoid M)

open set

@[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 {ι : Type*} {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

end non_assoc

end submonoid

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 ▸ 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

/-- 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. -/
def pow (n : M) (m : ℕ) : powers n := ⟨n ^ m, m, 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)

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 _

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

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

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


-- Suma_de_funciones_acotadas_superiormente.lean
-- La suma de dos funciones acotadas superiormente también lo está.
-- José A. Alonso Jiménez <https://jaalonso.github.io>
-- Sevilla, 28-noviembre-2022
-- ---------------------------------------------------------------------

-- ---------------------------------------------------------------------
-- Demostrar que la suma de dos funciones acotadas superiormente también
-- lo está.
-- ----------------------------------------------------------------------

import data.real.basic

variables {f g : ℝ → ℝ}
variables {a b : ℝ}

-- (cota_superior f a) se verifica si a es una cota superior de f.
def cota_superior (f : ℝ → ℝ) (a : ℝ) : Prop := ∀ x, f x ≤ a

-- (acotada_sup f) afirma que f tiene cota superior.
def acotada_sup (f : ℝ → ℝ) := ∃ a, cota_superior f a

-- Lema auxiliar
-- =============

lemma cota_superior_suma
  (hfa : cota_superior f a)
  (hgb : cota_superior g b)
  : cota_superior (f + g) (a + b) :=
λ x, add_le_add (hfa x) (hgb x)

-- 1ª demostración
-- ===============

example
  (hf : acotada_sup f)
  (hg : acotada_sup g)
  : acotada_sup (f + g) :=
begin
  cases hf with a hfa,
  cases hg with b hgb,
  have h3 : cota_superior (f + g) (a + b) :=
    cota_superior_suma hfa hgb,
  have h4 : ∃ z, ∀ x, (f + g) x ≤ z,
    by exact Exists.intro (a + b) h3,
  show acotada_sup (f + g),
    by exact h4,
end

-- 2ª demostración
-- ===============

example
  (hf : acotada_sup f)
  (hg : acotada_sup g)
  : acotada_sup (f + g) :=
begin
  cases hf with a hfa,
  cases hg with b hfb,
  use a + b,
  apply cota_superior_suma hfa hfb,
end

-- 3ª demostración
-- ===============

example
  (hf : acotada_sup f)
  (hg : acotada_sup g)
  : acotada_sup (f + g) :=
begin
  rcases hf with ⟨a, hfa⟩,
  rcases hg with ⟨b, hfb⟩,
  exact ⟨a + b, cota_superior_suma hfa hfb⟩
end

-- 4ª demostración
-- ===============

example :
  acotada_sup f → acotada_sup g → acotada_sup (f + g) :=
begin
  rintros ⟨a, hfa⟩ ⟨b, hfb⟩,
  exact ⟨a + b, cota_superior_suma hfa hfb⟩,
end

-- 5ª demostración
-- ===============

example :
  acotada_sup f → acotada_sup g → acotada_sup (f + g) :=
λ ⟨a, hfa⟩ ⟨b, hfb⟩, ⟨a + b, cota_superior_suma hfa hfb⟩


/-
Copyright (c) 2022 Violeta Hernández Palacios. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Violeta Hernández Palacios
-/

import data.complex.basic
import data.real.cardinality

/-!
# The cardinality of the complex numbers

This file shows that the complex numbers have cardinality continuum, i.e. `#ℂ = 𝔠`.
-/

open cardinal set

open_locale cardinal

/-- The cardinality of the complex numbers, as a type. -/
@[simp] theorem mk_complex : #ℂ = 𝔠 :=
by rw [mk_congr complex.equiv_real_prod, mk_prod, lift_id, mk_real, continuum_mul_self]

/-- The cardinality of the complex numbers, as a set. -/
@[simp] lemma mk_univ_complex : #(set.univ : set ℂ) = 𝔠 :=
by rw [mk_univ, mk_complex]

/-- The complex numbers are not countable. -/
lemma not_countable_complex : ¬ (set.univ : set ℂ).countable :=
by { rw [← le_aleph_0_iff_set_countable, not_le, mk_univ_complex], apply cantor }


/-
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

/-!

# Challenge sheet

This is a harder group theory question.

It turns out that two of the axioms in our definition of a group
are not needed; they can be deduced from the others. Let's define
a "weak group" class, where we only have three of the group axioms.
The question is: can you prove that a weak group is a group, by
proving the other axioms?

-/

-- removing `mul_one` and `mul_inv_self` from the five standard axioms
-- for a group.
class weak_group (G : Type) extends has_one G, has_mul G, has_inv G : Type :=
(mul_assoc : ∀ a b c : G, (a * b) * c = a * (b * c))
(one_mul : ∀ a : G, 1 * a = a)
(inv_mul_self : ∀ a : G, a⁻¹ * a = 1)

namespace weak_group

variables {G : Type} [weak_group G] (a b c : G)

/-

The challenge is to prove that G is a group, which we can interpret as
proving the missing axioms `mul_one` and `mul_inv_self`. Note that you
can't use the `group` tactic any more because `G` isn't a group yet:
this is what you're trying to prove!

One way of doing it: try proving

`mul_left_cancel : a * b = a * c → b = c`

and then

`mul_eq_of_eq_inv_mul : b = a⁻¹ * c → a * b = c`

first.

-/

-- proof using cool `calc` mode
lemma mul_left_cancel (h : a * b = a * c) : b = c :=
calc
  b = 1 * b         : by rw one_mul
... = (a⁻¹ * a) * b : by rw inv_mul_self
... = a⁻¹ * (a * b) : by rw mul_assoc
... = a⁻¹ * (a * c) : by rw h
... = (a⁻¹ * a) * c : by rw mul_assoc
... = 1 * c         : by rw inv_mul_self
... = c             : by rw one_mul

lemma mul_eq_of_eq_inv_mul (h : b = a⁻¹ * c) : a * b = c :=
begin
  apply mul_left_cancel a⁻¹,
  rwa [← mul_assoc, inv_mul_self, one_mul],
end

lemma mul_one (a : G) : a * 1 = a :=
begin
  apply mul_eq_of_eq_inv_mul,
  rw inv_mul_self,
end

lemma mul_inv_self (a : G) : a * a⁻¹ = 1 :=
begin
  apply mul_eq_of_eq_inv_mul,
  rw mul_one,
end

end weak_group

/-

If you want to take this further: prove that if we make
a new class `bad_group` by replacing
`one_mul` by `mul_one` in the definition of `weak_group`
then it is no longer true that you can prove `mul_inv_self`;
there are structures which satisfy `mul_assoc`, `mul_one`
and `inv_mul_self` but which really are not groups.
Can you find an example? Try it on paper first.

-/

-- claim: not a group in general
class bad_group (G : Type)
  extends has_one G, has_mul G, has_inv G : Type :=
(mul_assoc : ∀ a b c : G, (a * b) * c = a * (b * c))
(mul_one : ∀ a : G, a * 1 = a)
(inv_mul_self : ∀ a : G, a⁻¹ * a = 1)

instance : has_one bool := ⟨bool.tt⟩
instance : has_mul bool := ⟨λ x y, x⟩
instance : has_inv bool := ⟨λ x, 1⟩

instance : bad_group bool :=
{ mul_assoc := dec_trivial,
  mul_one := dec_trivial,
  inv_mul_self := dec_trivial,
}

example : ¬ (∀ a : bool, 1 * a = a) :=
begin
  dec_trivial,
end


import .list .num

namespace int

open list

def dot_prod : list int → list int → int
| [] [] := 0
| [] (_::_) := 0
| (_::_) [] := 0
| (a1::as1) (a2::as2) :=
  (a1 * a2) + dot_prod as1 as2

def map_neg_dot_prod :
  ∀ {as1 as2 : list int}, dot_prod (map_neg as1) as2 = -(dot_prod as1 as2)
| [] [] := begin simp [map_neg, dot_prod] end
| [] (_::_) := begin simp [map_neg, dot_prod] end
| (_::_) [] := begin simp [map_neg, dot_prod] end
| (a1::as1) (a2::as2) :=
  begin
    simp [map_neg, dot_prod],
    rw (@map_neg_dot_prod as1 as2).symm,
    simp [map_neg],
  end

lemma nil_dot_prod  :
  ∀ {as}, dot_prod [] as = 0
| [] := rfl
| (a::as) := rfl

lemma dot_prod_nil  :
  ∀ {as}, dot_prod as [] = 0
| [] := rfl
| (a::as) := rfl

lemma cons_dot_prod_cons_eq {a1 a2 as1 as2} :
dot_prod (a1::as1) (a2::as2) = (a1 * a2) + dot_prod as1 as2 := rfl

lemma comp_add_dot_prod  :
  ∀ (as1 as2 as3 : list int),
    dot_prod (comp_add as1 as2) as3 = (dot_prod as1 as3) + (dot_prod as2 as3)
| [] as2 as3 :=
  begin simp [dot_prod, nil_comp_add, nil_dot_prod] end
| as1 [] as3 :=
  begin simp [dot_prod, comp_add_nil, nil_dot_prod] end
| as1 as2 [] :=
  begin repeat {rewrite dot_prod_nil}, simp end
| (a1::as1) (a2::as2) (a3::as3) :=
  begin simp [dot_prod, comp_add, comp_add_dot_prod, add_mul] end

lemma comp_sub_dot_prod :
  ∀ (as1 as2 as3 : list int),
    dot_prod (comp_sub as1 as2) as3 = (dot_prod as1 as3) - (dot_prod as2 as3)
| [] as2 as3 :=
  begin simp [dot_prod, nil_comp_sub, map_neg_dot_prod, nil_dot_prod] end
| as1 [] as3 :=
  begin simp [dot_prod, comp_sub_nil, nil_dot_prod] end
| as1 as2 [] :=
  begin repeat {rewrite dot_prod_nil}, simp end
| (a1::as1) (a2::as2) (a3::as3) :=
  begin simp [dot_prod, comp_sub, comp_sub_dot_prod, add_mul] end

lemma map_mul_dot_prod {a : int} :
  ∀ {as1 as2}, dot_prod (map_mul a as1) as2 = a * (dot_prod as1 as2)
| [] as2 :=
  begin simp [map_mul, nil_dot_prod] end
| as1 [] :=
  begin
    repeat {rewrite dot_prod_nil},
    rewrite _root_.mul_zero a,
  end
| (a1::as1) (a2::as2) :=
  begin
    unfold map_mul, simp, repeat {rewrite cons_dot_prod_cons_eq},
    have h := @map_mul_dot_prod as1 as2, unfold map_mul at h,
    rewrite h, rewrite mul_add, simp, rewrite mul_assoc
  end

end int

namespace znum

open list

def dot_prod : list znum → list znum → znum
| [] [] := 0
| [] (_::_) := 0
| (_::_) [] := 0
| (a1::as1) (a2::as2) :=
  (a1 * a2) + dot_prod as1 as2

def map_neg_dot_prod :
  ∀ {as1 as2 : list znum}, dot_prod (map_neg as1) as2 = -(dot_prod as1 as2)
| [] [] := begin simp [map_neg, dot_prod] end
| [] (_::_) := begin simp [map_neg, dot_prod] end
| (_::_) [] := begin simp [map_neg, dot_prod] end
| (a1::as1) (a2::as2) :=
  begin
    simp [map_neg, dot_prod],
    rw (@map_neg_dot_prod as1 as2).symm,
    simp [map_neg],
  end

@[simp] lemma nil_dot_prod  :
  ∀ {as}, dot_prod [] as = 0
| [] := rfl
| (a::as) := rfl

@[simp] lemma dot_prod_nil  :
  ∀ {as}, dot_prod as [] = 0
| [] := rfl
| (a::as) := rfl

lemma cons_dot_prod_cons_eq {a1 a2 as1 as2} :
dot_prod (a1::as1) (a2::as2) = (a1 * a2) + dot_prod as1 as2 := rfl

lemma comp_add_dot_prod  :
  ∀ (as1 as2 as3 : list znum),
    dot_prod (comp_add as1 as2) as3 = (dot_prod as1 as3) + (dot_prod as2 as3)
| [] as2 as3 :=
  begin
    rewrite nil_comp_add,
    rewrite nil_dot_prod, simp
  end
| as1 [] as3 :=
  begin
    rewrite comp_add_nil,
    rewrite nil_dot_prod, simp
  end
| as1 as2 [] :=
  begin repeat {rewrite dot_prod_nil}, simp end
| (a1::as1) (a2::as2) (a3::as3) :=
  begin simp [dot_prod, comp_add, comp_add_dot_prod, add_mul] end

lemma comp_sub_dot_prod :
  ∀ (as1 as2 as3 : list znum),
    dot_prod (comp_sub as1 as2) as3 = (dot_prod as1 as3) - (dot_prod as2 as3)
| [] as2 as3 :=
  begin simp [dot_prod, nil_comp_sub, map_neg_dot_prod, nil_dot_prod] end
| as1 [] as3 :=
  begin simp [dot_prod, comp_sub_nil, nil_dot_prod] end
| as1 as2 [] :=
  begin repeat {rewrite dot_prod_nil}, simp end
| (a1::as1) (a2::as2) (a3::as3) :=
  begin simp [dot_prod, comp_sub, comp_sub_dot_prod, add_mul] end
lemma map_mul_dot_prod {a : znum} :
  ∀ {as1 as2}, dot_prod (map_mul a as1) as2 = a * (dot_prod as1 as2)
| [] as2 :=
  begin
    unfold map_mul, simp,
    repeat {rewrite nil_dot_prod}
  end
| as1 [] :=
  begin
    repeat {rewrite dot_prod_nil},
    rewrite mul_zero
  end
| (a1::as1) (a2::as2) :=
  begin
    unfold map_mul, simp, repeat {rewrite cons_dot_prod_cons_eq},
    have h := @map_mul_dot_prod as1 as2, unfold map_mul at h,
    rewrite h, rewrite mul_add, simp, rewrite mul_assoc
  end

lemma dot_prod_to_int' :
∀ {zs1 zs2 : list znum},
  (dot_prod zs1 zs2).to_int = int.dot_prod (map to_int zs1) (map to_int zs2)
| [] [] := rfl
| [] (a2::as2) := begin simp [nil_dot_prod, map], refl end
| (a1::as1) [] := begin simp [dot_prod_nil, map], refl end
| (a1::as1) (a2::as2) :=
  begin
    simp [int.cons_dot_prod_cons_eq, znum.cons_dot_prod_cons_eq,
      dot_prod_to_int', to_int, int.to_znum],
    have h := @dot_prod_to_int' as1 as2, simp [to_int] at h, rw h,
  end

lemma dot_prod_to_int :
∀ {zs1 zs2 : list znum},
  ↑(dot_prod zs1 zs2) = int.dot_prod (map to_int zs1) (map to_int zs2) :=
  @dot_prod_to_int'

lemma dot_prod_eq_of_forall_mem_zero :
  ∀ {zs1 zs2}, (∀ z ∈ zs1, z = (0 : znum)) → dot_prod zs1 zs2 = 0
| [] zs2 _ := nil_dot_prod
| (z1::zs1) zs2 h :=
  begin
    cases zs2, apply dot_prod_nil,
    simp [dot_prod], have hrw := (h z1 (or.inl rfl)),
    subst hrw, simp, apply dot_prod_eq_of_forall_mem_zero,
    apply forall_mem_of_forall_mem_cons h
  end

end znum

namespace num

open list

def dot_prod : list num → list num → num
| [] [] := 0
| [] (_::_) := 0
| (_::_) [] := 0
| (a1::as1) (a2::as2) :=
  (a1 * a2) + dot_prod as1 as2

@[simp] lemma nil_dot_prod  :
  ∀ {as}, dot_prod [] as = 0
| [] := rfl
| (a::as) := rfl

@[simp] lemma dot_prod_nil  :
  ∀ {as}, dot_prod as [] = 0
| [] := rfl
| (a::as) := rfl

lemma comp_add_dot_prod  :
  ∀ (as1 as2 as3 : list num),
    dot_prod (comp_add as1 as2) as3 = (dot_prod as1 as3) + (dot_prod as2 as3)
| [] as2 as3 :=
  begin
    rewrite nil_comp_add,
    rewrite nil_dot_prod, simp
  end
| as1 [] as3 :=
  begin
    rewrite comp_add_nil,
    rewrite nil_dot_prod, simp
  end
| as1 as2 [] :=
  begin repeat {rewrite dot_prod_nil}, simp end
| (a1::as1) (a2::as2) (a3::as3) :=
  begin
    simp [dot_prod, comp_add, comp_add_dot_prod as1 as2 as3, add_mul]
  end

lemma cons_dot_prod_cons_eq {a1 a2 as1 as2} :
dot_prod (a1::as1) (a2::as2) = (a1 * a2) + dot_prod as1 as2 := rfl

lemma dot_prod_to_znum' :
∀ {ns1 ns2 : list num},
  (dot_prod ns1 ns2).to_znum = znum.dot_prod (map to_znum ns1) (map to_znum ns2)
| [] [] := rfl
| [] (a2::as2) := begin simp [nil_dot_prod, map], refl end
| (a1::as1) [] := begin simp [dot_prod_nil, map], refl end
| (a1::as1) (a2::as2) :=
  begin
    simp [num.cons_dot_prod_cons_eq, znum.cons_dot_prod_cons_eq,
       dot_prod_to_znum', num.mul_to_znum'],
  end

lemma map_mul_dot_prod {a : num} :
  ∀ {as1 as2}, dot_prod (map_mul a as1) as2 = a * (dot_prod as1 as2)
| [] as2 := begin simp [map_mul] end
| as1 [] :=  begin simp [map_mul] end
| (a1::as1) (a2::as2) :=
  begin
    unfold map_mul, simp, repeat {rewrite cons_dot_prod_cons_eq},
    have h := @map_mul_dot_prod as1 as2, unfold map_mul at h,
    rewrite h, rewrite mul_add, simp, rewrite mul_assoc
  end

end num


-- ---------------------------------------------------------------------
-- Ejercicio 1. Realizar las siguientes acciones:
--    1. Importar la teoría de anillos.
--    2. Crear el espacio de nombres my_ring
--    3. Declarar R como una variable sobre anillos.
--    4. Declarar a como variable sobre R.
-- ----------------------------------------------------------------------

import algebra.ring            -- 1
namespace my_ring              -- 2
variables {R : Type*} [ring R] -- 3
variables (a : R)              -- 4

-- ---------------------------------------------------------------------
-- Ejercicio 2. Demostrar que
--     a - a = 0
-- ----------------------------------------------------------------------

theorem self_sub : a - a = 0 :=
calc
  a - a = a + -a : sub_eq_add_neg a a
  ...   = 0      : by rw add_right_neg

end my_ring


import data.nat.prime

/-
We prove that sqrt 2 is irrational. To make things simple, we work with natural numbers instead
of rational numbers. The idea is to derive a contradiction from the assumption that
`(a^2 = 2 * (b ^ 2))` for coprime natural nubmers `a` and `b`.
-/

-- First an auxiliary result to show `2 ∣ x` if `x * x = 2 * y`.
lemma aux {x y : ℕ} (h : x * x = 2 * y) : 2 ∣ x :=
(or_self (2 ∣ x)).mp $ (nat.prime.dvd_mul nat.prime_two).mp ⟨y, h⟩

-- Proof of the irrationality of sqrt 2.
example (a b : ℕ) (cop : nat.coprime a b) : ¬(a^2 = 2*b^2) :=
begin
  simp only [pow_two],
  intro h,
  have twodiva : 2 ∣ a := aux h,
  have twodiva' := twodiva, -- make a copy!
  cases twodiva' with m hm,
  rw [hm, mul_assoc] at h,
  have hdiv : m * (2* m) = b * b, from mul_left_cancel' two_ne_zero h,
  rw [mul_comm, mul_assoc] at hdiv,
  have twodivb : 2 ∣ b := aux hdiv.symm,
  exact nat.not_coprime_of_dvd_of_dvd one_lt_two twodiva twodivb cop,
end


import data.set
import tactic.ring

namespace relation

-- Jakob Kauffmann (jgk2qq); github: jakekauff13
-- Collaborated with: Jumi Hall (jah5py) &
--                    Connor McCaffrey (cam7qp)

-- PRELIMINARY SETUP

/-
Preliminary set up. For the rest of this file,
we specify an arbitrary binary relation, r, on
an arbitrary type, β, as a two-place predicate,
with infix notation x ≺ y for (r x y). One can
pronounce these expressions in English as "x is
related to y".
-/
variables {α β : Type}  (r : β → β → Prop)
local infix `≺` : 50 := r

/-
The default Lean libraries are missing definitions
for the assympetric property of relations and for
the notion of a powerset. We define these terms for
use in the rest of this file.
-/
def asymmetric := ∀ ⦃x y⦄, x ≺ y → ¬ y ≺ x
def powerset (s : set β) := { s' | s' ⊆ s}

-- PROBLEMS

/-
#1: Give both a formal and an English-language proof. Then
answer the question, is the proposition true if you remove
the first condition, that β is inhabited? Briefly explain
your answer (in English).
-/
example : (∃ (b : β), true) → asymmetric r → ¬reflexive r :=
begin
  assume e,
  assume a,
  assume x,
  unfold asymmetric at a,
  unfold reflexive at x,
  cases e with w pf,
  have rww := x w,
  have c := a rww,
  contradiction,
end
  -- English-Language Proof:
      /-
      Proof: Suppose β is inhabited and r is asymmetric.
      We now show r is not reflexive. We will prove by
      negation, assuming that r is reflexive and then
      we will show that this assumption leads to a contradiction
      from which we can conclude r is not reflexive.

      To derive the contradiction, we first expand the
      definitions of asymmetric and reflexive. We will
      now show that the following assumptions contradict
      one another:

        β: Type
        r: β → β → Prop
        e: ∃ (b : β), true
        a: ∀ ⦃x y : β⦄, r x y → ¬r y x
        x: ∀ (x : β), r x x

      To show this by exists elimination we first infer
      that there is a an object, w : β, of which we
      have a proof of existence. Applying reflexivity (x),
      to w, we deduce w ≺ w (r w w). Next, by applying
      asymmetry (a), to w ≺ w we derive w ⊀ w, thus deriving
      the aforementioned contradiction.
      QED.
      -/

/-
#2. Logic, like programming, is subtle. It's very easy for humans
to miss subtle corner cases. As an example, today I ran across
a problem in a textbook by Paul Traiger, a professor emeritus
of philosophy and cognitive science at Occidental College. He
asks students to prove that if a relation is both transitive and
reflexive that it cannot be anti-symmetric. See the question at
the very bottom of the page here:
https://sites.oxy.edu/traiger/logic/exercises/chapter13/properties_of_relations_exercise.html

Is the conjecture actually logically valid? If not, what condition
needs to be added to make it so? Try prove this/his version of the
conjecture, as articulated slightly differently below. If you get
stuck, then you need to figure out an additional condition that needs
to be added as a premise to make the proposition true. In that case,
add the premise and then show that the updated conjecture is true.
-/
example : (∃ (b : β), true) → transitive r → reflexive r → ¬ asymmetric r :=
begin
  assume h,
  unfold transitive reflexive asymmetric,
  assume t r a,
  cases h with b True,
  have b_refl := r b,
  have b_not_refl := a b_refl,
  contradiction,
end

/-
#3: Prove that the subset relation on the powerset of any
set, s, is antisymmetric. Formally state and prove, and
then give an informal proof of, this proposition.
-/
example : ∀ (s : set β)
            (s1 s2 ∈ powerset s),
            s1 ⊆ s2 →
            s2 ⊆ s1 →
            s1 = s2 :=
begin
  assume s s1 s2 s1ins s2ins s1ins2 s2ins1,
  apply set.ext,
  assume x,
  split,
  assume xins1,
  exact s1ins2 xins1,

  assume xins2,
  exact s2ins1 xins2,
end

/-
Proof: Suppose that s is a set of type β and that s1 and s2
are in the powerset of s. We will prove that s1 = s2, assuming
the following: s1 ⊆ s2 and s2 ⊆ s1.

First, we equate the equals sign to an if and only if statement
under set extensionality. By application of our assumptions
on one another, we derive that s1 = s2.

QED.
-/

/-
Given two natural numbers, n and m, we will say that m divides n
if there is a natural number, k, such that n = k*m. Here's a formal
definition of this relation.
-/
def divides (m n : ℕ) := ∃ k, n = k * m

/-
#4: Formally and informally state and prove each of the following
propositions. Remember that the ring tactic is useful for producing
proofs of simple algebraic equalities involving + and *. You can use
the phrase, "by basic algebra" when translating the use of this tactic
into English. (Or if you wanted to be truly Hobbit-like you could say
"by the ring axioms!")
-/

-- A: For any n, 1 divides n.
example : ∀ n, divides 1 n :=
begin
  assume n,
  unfold divides,
  cases n with p,
  apply exists.intro 0,
  refl,
  apply exists.intro p.succ,
  have mulone := mul_one p.succ,
  rw mulone,
end

/-
Proof: We provide a proof that for any n, 1 divides n. In order
to provide this proof, we first assume n of type ℕ. Next, we
expand the definition of divides. We will then perform case analysis on
n to prove that there exists a k such that n = k * 1.

Case analysis yields two cases which we will prove, thus proving that
1 divides n. The first case is that in which n = 0. After application of
the exists introduction rule with the value 0, we now prove by simple algebra
that 0 = 0 * 1. The second case is that is which n > 0. Similarly, we show that
there exists a k such that n = k * 1, and that k is again equal to n.

QED.
-/

-- B. For any n, n divides n
example : ∀ n, divides n n :=
begin
  assume n,
  unfold divides,
  apply exists.intro 1,
  have mulone := one_mul n,
  rw mulone,
end
/-
Proof: We provide a proof that for any n, n divides n. We first assume
n is of type ℕ, then we expand the definition of divides. After applying
the exists introduction rule with a value of 1, we must prove that
n = 1 * n, which is done by simple algebra.

QED.
-/

-- #C. prove that divides is reflexive
example : reflexive divides :=
begin
  unfold reflexive divides,
  assume n,
  apply exists.intro 1,
  have mulone := (one_mul n),
  rw mulone,
end
/-
Proof: We will provide a proof that divides is reflexive. We first assume
n is of type ℕ, and then we expand the definition of divides and reflexive. After applying
the exists introduction rule with a value of 1, we must prove that
n = 1 * n, which is done by simple algebra.
-/

-- #D. prove that divides is transitive
example : transitive divides :=
begin
  unfold transitive divides,
  assume a b c,
  assume ab bc,
  cases ab with a1 p1,
  cases bc with a2 p2,
  apply exists.intro(a2*a1),
  rw p2,
  rw p1,
  have mulassoc := mul_assoc a2 a1 a,
  rw mulassoc,
end

/-
Proof: We will provide a proof that divides is transitive. We first expand
the definition of transitive and divides. We will then make the following
assumptions:

  a b c : ℕ
  ab : ∃ (k : ℕ), b = k * a
  bc : ∃ (k : ℕ), c = k * b

Under these assumptions, we will prove that there exists a k such that
c = k * a, showing that divides is transitive. We begin by performing case
analysis on both ab and bc, yielding the following assumptions:

  a b c a1 a2 : ℕ
  p1 : b = a1 * a
  p2 : c = a2 * b

We will use these assumptions to rewrite the final proposition c = k * a
to now be a2 * a1 * a = a2 * a1 * a. We do this by applying the exists
introduction rule for the value a2 * a1, converting the proposition into
c = a2 * a1 * a. Next, we have the proofs that c = a2 * b and b = a1 * a.
Using these, we can rewrite the final proposition as a2 * a1 * a = a2 * a1 * a,
which is true by reflexivity of equality.

QED.
-/

/-
E. Is divides symmetric? if yes, give a proof, otherwise
give a counterexample and a brief explanation to show that
it's not.
-/

example: symmetric divides :=
begin
end
-- Divides is NOT symmetric, as shown by the cases where 2 divides 4
-- (k = 2, which is a natural number), but 4 does not divide 2
-- (k = 1/2, which is not a natural number).
-- In order for a relation to be symmetric, the relation
-- must hold between the two values in both directions. However, with divides,
-- a natural number does not exist such that a number divides a larger number,
-- and that larger number divides the smaller number.

/-
#F. Prove that divides is antisymmetric.
-/
example : anti_symmetric divides :=
begin
  unfold anti_symmetric divides,
  assume x y xy yx,
  apply exists.elim xy,
  apply exists.elim yx,
  assume a b c d,
  rw b,
  have : a = 1 := sorry,
  rw this,
  have mulone := one_mul y,
  exact mulone,
end

/-
Proof: We will prove that divides is antisymmetric. First, we expand the
definitions of antisymmetric and divides. Then we perform case analysis on our
assumed exists statements, leaving us to rewrite the cases. It is obvious that the
value of a must be 1 by simple deduction from already present proofs, leaving us
again to simply rewrite our goal, giving us a new goal that 1 * y = y, which is
true by simple algebra.

QED.
-/

/- #5
Prove the following propositions. Remember that
throughout this file, each definition implicitly
includes β as a type and r as an arbitrary binary
relation on β. In addition to formal proofs, give
an English language proof of the last of the three
problems.
-/

-- A
example : asymmetric r → irreflexive r :=
begin
  assume h x k,
  have nk := h k,
  contradiction,
end
/-
Proof: We will provide a proof that a relation is irreflexive, given
that the relation is asymmetric, by negation. We do this by assuming that
r x x is true and showing that ¬ r x x is true by applying the proof that
the relation is asymmetric to r x x, thus deriving a contradiction.

QED.
-/
-- B
example : irreflexive r → transitive r → asymmetric r :=
begin
  unfold irreflexive transitive,
  assume i t x y,
  assume rxy,
  assume nryx,
  have f := t rxy nryx,
  have nrxx := i x,
  contradiction,
end

/-
Proof: We will provide a proof by negation that a relation is asymmetric,
given that the relation is irreflexive and transitive. We first expand the
definitions of irreflexive and transitive. Then we make the assumptions that
the relation r is irreflexive and transitive. Next, we assume r x y and ¬ r y x.
After this, we apply transitive to r x y and ¬ r y x to derive a proof of r x x.
Finally, we show a contradiction by applying irreflexive to x, which gives us ¬ r x x.

QED.
-/

-- C
example : transitive r → ¬ symmetric r → ¬ irreflexive r :=
begin
  unfold transitive symmetric irreflexive,
  assume trans symm irrefl,
end

/-
We do not believe that the proposition is provable or fixable. We tried to
add that β is inhabited, but this effort was futile. We were unable
to find a counter-example of a relation that shows the invalidity
of the proposition.
-/
end relation


import tactic
import init.logic -- 引用关于逻辑的基本定理

-- Let `Ω` be a "big underlying set" and let `X` and `Y` and `Z` be subsets

variables (Ω : Type) (X Y Z : set Ω) (a b c x y z : Ω)

namespace xena

/-!

# subsets

Let's think about `X ⊆ Y`. Typeset `⊆` with `\sub` or `\ss`
-/

-- `X ⊆ Y` is the same as `∀ a, a ∈ X → a ∈ Y` , by definition.

lemma subset_def : X ⊆ Y ↔ ∀ a, a ∈ X → a ∈ Y :=
begin
  -- true by definition
  refl
end

lemma subset_refl : X ⊆ X :=
begin
  -- 想要证明一个新概念的性质，先从其定义入手
  rw subset_def,
  -- 遇到包含 ∀ 的命题，可以尝试intro策略
  intro a,
  intro a_in_X,
  exact a_in_X,
end
--  ⊆ 的自反性(reflexivity)在mathlib中已经证明过了，所以你也可以使用一个relf策略完成证明

--
lemma subset_trans (hXY : X ⊆ Y) (hYZ : Y ⊆ Z) : X ⊆ Z :=
begin
  -- If you start with `rw subset_def at *` then you
  -- will have things like `hYZ : ∀ (a : Ω), a ∈ Y → a ∈ Z`

  -- You need to think of `hYZ` as a function, which has two
  -- inputs: first a term `a` of type `Ω`, and second a proof `haY` that `a ∈ Y`.
  -- It then produces one output `haZ`, a proof that `a ∈ Z`.

  -- You can also think of it as an implication:
  -- "if a is in Ω, and if a ∈ Y, then a ∈ Z". Because it's an implication,
  -- you can `apply hYZ`. This is a really useful skill!

  rw subset_def at *, -- 把已知条件和目标中所有 ⊆ 用定义替换
  intro a,
  intro a_in_X,

  apply hYZ,  -- 已知条件中有 a : Ω , 满足hYZ的前提: "a : Ω "
  apply hXY,  -- 同上
  exact a_in_X,
end

/-!

# Equality of sets

Two sets are equal if and only if they have the same elements.
The name of this theorem is `set.ext_iff`.
-/

example : X = Y ↔ (∀ a, a ∈ X ↔ a ∈ Y) :=
begin
  exact set.ext_iff
end

-- In practice, you often have a goal `⊢ X = Y` and you want to reduce
-- it to `a ∈ X ↔ a ∈ Y` for an arbitary `a : Ω`. This can be done with
-- the `ext` tactic.

--    此证明的名称      (已知条件1)     (已知条件2)    :  目标  :=
lemma subset.antisymm (hXY : X ⊆ Y) (hYX : Y ⊆ X) : X = Y :=
begin
  -- start with `ext a`,
  ext? a,
  -- 在 ext 后加问号可以看到此处的 ext 等效于哪些证明策略

  split,
  { -- ⊢ x ∈ X → x ∈ Y
    intro a_in_X,
    apply hXY,      -- 无需手动按定义展开也可以直接 apply
    exact a_in_X,
    },
  { -- ⊢ x ∈ Y → x ∈ X
    intro a_in_Y,
    apply hYX,
    exact a_in_Y,
    }
  -- 如果你对如下事实感到困惑：
  --  对目标 a ∈ X 使用 apply hYX (Y ⊆ X) 会得到 a ∈ Y
  -- 那么请注意此处 a ∈ X 是需要证明的目标，而非已知条件；apply在修改证明目标，而非推出结论。
  -- 如果仍然无法理解，请在证明开头添加 rw subset_def at *
end

/-!

### Unions and intersections

Type `\cup` or `\un` for `∪`, and `\cap` or `\i` for `∩`

-/

lemma union_def : a ∈ X ∪ Y ↔ a ∈ X ∨ a ∈ Y :=
begin
  -- true by definition
  refl,
end

lemma inter_def : a ∈ X ∩ Y ↔ a ∈ X ∧ a ∈ Y :=
begin
  -- true by definition
  refl,
end

-- You can rewrite with those lemmas above if you're not comfortable with
-- assuming they're true by definition.

-- union lemmas

lemma union_self : X ∪ X = X :=
begin
  ext a,
  rw union_def,
  split,
  { -- ⊢ a ∈ X ∨ a ∈ X → a ∈ X
    intro h,
    cases h with h1 h2,
    exact h1,
    exact h2,
  },
  { -- ⊢ a ∈ X → a ∈ X ∨ a ∈ X
    intro h,
    left,
    exact h,
  }
end

lemma subset_union_left : X ⊆ X ∪ Y :=
begin
  rw subset_def,
  intros a a_in_X,

  -- rw union_def,  -- 形如 a ∈ X ∪ Y 的目标可以直接使用left right策略，如果不理解 请删去行首注释再查看
  left,
  exact a_in_X,
end

lemma subset_union_right : Y ⊆ X ∪ Y :=
begin
  rw subset_def,
  intros a a_in_Y,

  -- rw union_def,  -- 同上题
  right,
  exact a_in_Y,
end

lemma union_subset_iff : X ∪ Y ⊆ Z ↔ X ⊆ Z ∧ Y ⊆ Z :=
begin
  split,
  { -- ⊢ X ∪ Y ⊆ Z → X ⊆ Z ∧ Y ⊆ Z
    intro hXunYssZ,
    split,
    -- ⊢ X ⊆ Z
      -- rw subset_def,
      intros a a_in_X,    -- 对于 X ⊆ Z , 可以使用intros得出 a : Ω 和 a_in_X : a ∈ X , 定义如此
      -- rw subset_def at hXunYssZ,
      apply hXunYssZ,     -- 若不理解请去掉rw前的注释以查看定义
      left,
      exact a_in_X,

    -- ⊢ Y ⊆ Z
      intros a a_in_Y,
      apply hXunYssZ,
      right,
      exact a_in_Y,
  },
  {
    intros h a a_in_XuY,
    cases h with XssZ YssZ,
    cases a_in_XuY with a_in_X a_in_Y,
    -- z ∈ X
      apply XssZ,
      exact a_in_X,
    -- a ∈ Y
      apply YssZ,
      exact a_in_Y,
  }
end

/-
  目标是关于集合的命题，该如何处理？
    1，最基本的方法：使用rewrite(rw)将其改写成定义
    2，形如 X ⊆ Z, 用intros或两次intro
    3，形如 X = Y, 考虑 ext
    4，形如 a ∈ X ∪ Y, 可使用left right

  已知条件是关于集合的命题，如何使用?
    1.使用定义重写: rw _ at _
    2.形如 X ⊆ Z, 考虑apply
    3.形如 X ∪ Y , X ∩ Y , 可以cases（本质上是对 ∧ ∨ cases）
    4.形如 X = Y , 可以使用 rw
  -/

variable (W : set Ω)

lemma union_subset_union (hWX : W ⊆ X) (hYZ : Y ⊆ Z) : W ∪ Y ⊆ X ∪ Z :=
begin
  intros a a_in_WuY,
  cases a_in_WuY with a_in_W a_in_Y,
  { -- known:
    left,
    apply hWX,
    exact a_in_W,
  },
  {
    right,
    apply hYZ,
    exact a_in_Y,
  }
end

lemma union_subset_union_left (hXY : X ⊆ Y) : X ∪ Z ⊆ Y ∪ Z :=
begin
  have ZssZ : Z ⊆ Z, {
    refl
  },
  apply union_subset_union,
  exact hXY,
  exact ZssZ,
end

-- etc etc

-- intersection lemmas

lemma inter_subset_left : X ∩ Y ⊆ X :=
begin
  intros a a_in_XiY,
  cases a_in_XiY with a_in_X a_in_Y,
  exact a_in_X,
end

-- don't forget `ext` to make progress with equalities of sets

lemma inter_self : X ∩ X = X :=
begin
  ext,
  split,
  { -- ⊢ x ∈ X ∩ X → x ∈ X
    intro x_in_XiX,
    cases x_in_XiX with x_in_X x_in_X,
    exact x_in_X,
  },
  { -- ⊢ x ∈ X → x ∈ X ∩ X
    intro x_in_X,
    split,
    exact x_in_X,
    exact x_in_X,
  },
end

lemma inter_comm : X ∩ Y = Y ∩ X :=
begin
  ext,
  split,
  { -- ⊢ x ∈ X ∩ Y → x ∈ Y ∩ X
    intro h,
    cases h with x_in_X x_in_Y,
    split,
    exact x_in_Y,
    exact x_in_X,
  },
  { -- ⊢ x ∈ Y ∩ X → x ∈ X ∩ Y
    intro h,
    cases h with x_in_Y x_in_X,
    split,
    exact x_in_X,
    exact x_in_Y,
  }
end

-- inter_def : a ∈ X ∩ Y ↔ a ∈ X ∧ a ∈ Y
lemma inter_assoc : X ∩ (Y ∩ Z) = (X ∩ Y) ∩ Z :=
begin
  ext,
  split,
  { -- ⊢ x ∈ X ∩ (Y ∩ Z) → x ∈ X ∩ Y ∩ Z
    intro h,
    -- rcases：等价于两条cases
    -- cases h with x_in_X h,
    -- cases h with x_in_Y x_in_Z,
    rcases h with ⟨x_in_X, x_in_Y, x_in_Z⟩,

    split,
    split,
    exact x_in_X,
    exact x_in_Y,
    exact x_in_Z,
  },
  { -- ⊢ x ∈ X ∩ Y ∩ Z → x ∈ X ∩ (Y ∩ Z)
    intro h,
    -- 请尝试将这里改写为一条rcases
    cases h with h x_in_Z,
    cases h with x_in_X x_in_Y,

    split,
    exact x_in_X,
    split,
    exact x_in_Y,
    exact x_in_Z,
  }
end

/-!

### Forall and exists

-/
-- 关于存在命题的证明和使用方法，请查阅手册
-- https://leanprover-community.github.io/mathlib_docs/init/logic.html#Exists
-- 请在手册中自行查找全称命题的说明

lemma not_exists_iff_forall_not : ¬ (∃ a, a ∈ X) ↔ ∀ b, ¬ (b ∈ X) :=
begin
  split,
  { -- ¬ ∃ → ∀
    intro h,
    intro b,
    intro b_in_X,
    apply h,
    use b,      -- 指出满足goal的元素b
    -- existsi b, -- 与use等价
    exact b_in_X,
  },
  { -- ∀ → ¬ ∃
    intro h,
    intro hExist,
    -- cases 从存在命题抽出 a 及其性质 a ∈ X
    cases hExist with a ha,
    apply (h a),  -- (h a) : a ∉ X
    exact ha,
  }
end

example : ¬ (∀ a, a ∈ X) ↔ ∃ b, ¬ (b ∈ X) :=
begin
  split,
  { -- ¬ ∀ → ∃
    -- 此处的goal不是直觉主义逻辑中的定理，仅使用构造方式无法证明，需要用到反证法
    intro h,
    by_contra hE,
    apply h,
    intro a,
    by_contra aNotInX,
    apply hE,
    use a,
  },
  { -- ∃ → ¬ ∀
    intro h,
    intro hAll,
    cases h with a ha,
    apply ha,
    apply hAll,
  }
end

end xena


/- TACTICS -/

namespace TBA

-- definitions from last week
-- NOTE: We renamed it from `Nat'` for consistency. The new namespace makes sure we don't use the
-- standard library `Nat`.
inductive Nat : Type where
  | zero : Nat
  | succ (n : Nat) : Nat

open Nat

def add (m n : Nat) : Nat :=
  match n with
  | zero   => m
  | succ n => succ (add m n)

-- With this command we add a notation for `add`. From now on we will be able to write `m + n` for
-- `add m n`. The 65 denotes how strongly the operator should bind to what's adjacent to it.
-- The `priority` means that Lean will prefer it over the built-in `+`.
infix:65 (priority := high) " + " => add

def mul (m n : Nat) : Nat :=
  match n with
  | zero   => zero
  | succ n => (mul m n) + m

-- We also want a notation for `mul`, with a higher binding strength than addition so that
-- `a + b * c` means `a + (b * c`)`.
infix:70 (priority := high) " * " => mul

inductive LE : Nat → Nat → Prop where
  | refl (n : Nat) : LE n n
  | succ : LE m n → LE m (succ n)

-- lower binding strength than either addition or multiplication
infix:50 (priority := high) " ≤ " => LE

-- Let's start by reproving some theorems from last week, but this time with tactics!
-- useful tactics:
-- * `induction ... with ...`
-- * `rw [f]` to unfold applications of a function `f`
-- * `rw [h]` to rewrite every `a` to `b` if `h : a = b`
-- * `apply/exact`
-- * `simp/simp_all`... are powerful and basically always useful, though make sure that you could also
--   do the proof without them
theorem zero_add : zero + n = n := by
  induction n with
  | zero      =>
    rfl
  | succ n ih =>
    rw [add, ih]
  -- or simply
  --induction n <;> simp_all [add]

theorem le_add : m ≤ m + n := by
  induction n with
  | zero =>
    apply LE.refl
    -- same as
    --exact LE.refl _
  | succ n ih =>
    rw [add]  -- optional, but helpful
    apply LE.succ
    apply ih
    -- same as
    --exact LE.succ ih
    -- alternatively, simply use
    --simp [add, LE.succ, ih]
    -- ...but using a conditional simp theorem like `LE.succ` is usually not obvious
    -- when first writing a proof
  -- or simply
  --induction n <;> simp_all [LE.refl, LE.succ, add]

-- Alright, let's start automating more!
attribute [simp] add mul
-- These definitions will now automatically be unfolded when you use `simp/simp_all`

theorem succ_add : (succ n) + m = succ (n + m) := by
  induction m <;> simp_all [zero_add]

-- This one is a bit more tricky, you might need to prove a helper lemma!
theorem add_comm : n + m = m + n := by
  induction n with
  | zero      => exact zero_add
  | succ n ih => simp [succ_add, ih]

-- Associativity can be proven in a similar way.
theorem add_assoc : (m + n) + k = m + (n + k) := by
  induction k with
  | zero      => rfl
  | succ k ih => simp [succ_add, ih]

def one := succ zero

theorem mul_one : m * one = m := by
  simp [zero_add]

-- To prove associativity of multiplication, you might have to come up with
-- some more lemmas about multiplication first. Some are similar to the above laws of
-- addition, some use both addition and multiplication ("distributivity" is the keyword).

theorem left_distrib : m * (n + k) = (m * n) + (m * k) := by
  induction k with
  | zero      => simp
  | succ k ih =>
    rw [add, mul, mul, ih, add_assoc]
    -- NOTE: We *could* also use `add_assoc` as a simp theorem here.
    -- ```
    --  | succ n ih => simp [add_succ, ih, add_assoc]
    -- ```
    -- This even works with `add_comm` since `simp` is clever enough to avoid
    -- permutating applicable terms endlessly! However, such general simp theorems
    -- are best avoided for performance reasons and unintended interactions with
    -- other simp theorems.

theorem mul_assoc : (m * n) * k = m * (n * k) := by
  induction k with
  | zero      => rfl
  | succ k ih => simp [ih, left_distrib]

-- Remember the structures for semigroups and monoids which we defined last week?
structure Semigroup (α : Type) where
  mul   : α → α → α
  assoc : mul (mul a b) c = mul a (mul b c)

structure Monoid (α : Type) extends Semigroup α where
  e     : α
  e_mul : mul e a = a
  mul_e : mul a e = a

theorem one_mul : one * m = m := by
  induction m with
  | zero      => rfl
  | succ m ih => simp [ih]

-- You should now be able to instantiate two of them, including proofs!
def Nat_add_Monoid : Monoid Nat := {
  mul   := add
  assoc := add_assoc
  e     := zero
  e_mul := zero_add
  mul_e := rfl
}

def Nat_mul_Monoid : Monoid Nat := {
  mul   := mul
  assoc := mul_assoc
  e     := one
  e_mul := one_mul
  mul_e := mul_one
}

end TBA


import tactic
/-!
Plan for today
- inductive types
- the problem with the course
- trees
-/

inductive mynat : Type -- no :=
| zero : mynat
| succ : mynat → mynat

-- This is Peano's definition of ℕ
-- but if look on Wikipedia you see

#print mynat
#print mynat.zero
#print mynat.succ
#print mynat.rec --automatically made by Lean
--- The principle of induction and recursion

-- how to prove (1) succ is injective and 92) succ n ≠ zero ?

-- prove them by making more defintions
namespace mynat
-- we have our zero inside out namespace
#check zero

def is_zero : mynat → Prop
| zero := true
| (succ n) := false

lemma zero_is_zero : is_zero zero :=
begin
  change true,
  trivial,
end

lemma succ_ne_zero (n : mynat) : ¬ (is_zero (succ n)) :=
begin
  change ¬ false,
  exact id,
end

lemma zero_ne_succ (n : mynat) : succ n ≠ zero :=
begin
  intro h,
  apply succ_ne_zero,
  rw h,
  apply zero_is_zero,
end

def add : mynat → mynat → mynat
| n zero := n
| n (succ m) := succ (add n m)

instance : has_add mynat :=
{ add := add }

lemma add_zero (n : mynat) : n + zero = n :=
begin
  refl,
end

-- injectivity of succ
-- one way of doing it is to write a one sided inverse
-- f: X → Y so if ∃ g: Y → X such that ∀ x, g(f(x)) = x
-- f is the successor function which goes from ℕ to ℕ

def pred : mynat → mynat -- no :=
| zero := succ(succ(succ(succ(succ(zero)))))--anywhere is fine
| (succ n) := n

lemma pred_succ (n : mynat) : pred (succ n) = n :=
begin
  -- how to prove this?
  refl, --does the trick
end

-- there is a way to switch off dot notation but Kevin doesn't remember
lemma succ_inj : function.injective succ :=
begin
  intros a b h,
  apply_fun pred at h,
  -- same as but apply_fun is easier to remember (probably)
  --replace h := congr_arg pred h,
  simpa [pred_succ] using h,
end

end mynat

inductive mylist (X : Type) : Type
| nil : mylist -- empty list
| cons (x : X) (l : mylist) : mylist -- put x at the beginning

namespace mylist
variables (a b c : ℕ)

-- list [a,b,c] of naturals
example : mylist ℕ := cons a (cons b (cons c nil))

variable {X : Type} -- make X implicit

-- joining lists together
def add : mylist X → mylist X → mylist X
| nil l := l
| (cons x m) l := cons x (add m l)

def singleton (x : X) : mylist X := cons x nil

def reverse : mylist X → mylist X
| nil := nil
| (cons x m) := add (reverse m) (singleton x)

-- Here is a surprisingly difficult question
theorem tricky (l : mylist X) : reverse (reverse l) = l :=
begin
  sorry,
end

end mylist

/-!
Now lets talk about graphs

*staring at mathlib/combinatorics/simple_graph/connectivity.lean file*
explaining what walk, trail, path, and cycles are in simple graphs

is_tree is a property of the graph and not of a walk
a tree is a graph which is connected but does not have a cycle

Tree: ∀ u, v ∈ V, ∃! p : path u v
Then theorem: no cycles

Problem new defs in mathlib in febuary but we have a version from Jan
So best create a new repo to do the graph theory stuff

Or one can do ``leanproject up`` in terminal to update mathlib.
-/

/-
THIRD ORALS sketch

Hand in deadline is 1PM Friday 1st for April

Proposal: we have a "conference" 2 PM to 3:30PM you all give 3 minute talks
on the 1st of April

where you share your screen and your code and say something about it
and convince Kevin we understand our code

No questions

Hybrid, people can be online or in person
-/


/-
Copyright (c) 2022 OpenAI. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Daniel Selsam
-/
import data.nat.basic
import data.list.basic
import data.list.pairwise
import tactic.fin_cases

open tactic

/--
The ages of Jonie's four cousins are distinct single-digit positive integers.
Two of the cousins' ages multiplied together give $24$, while the other two multiply to $30$.
What is the sum of the ages of Jonie's four cousins?
-/
theorem amc10b_2021_p1 (c1 c2 c3 c4 : ℕ) :
  c1 * c2 = 24
  → c3 * c4 = 30
  → list.pairwise (≠) [c1, c2, c3, c4]
  → list.all [c1, c2, c3, c4] (λ n, n < 10)
  → c1 ≤ c2 -- TODO: these should be wlog-ed rather than built-in
  → c3 ≤ c4
  → c1 + c2 + c3 + c4 = 22 :=
begin
  intros h12 h34 h_pairwise h_bounds h12_le h34_le,
  simp at h_pairwise h_bounds,
  cases_matching* [_ ∨ _, _ ∧ _],
  have h12_options : c1 = 3 ∧ c2 = 8 ∨ c1 = 4 ∧ c2 = 6,
  {
    -- TODO: interval_cases hits a deterministic timeout on ⬝ < 10
    have h_c1 : c1 ∈ finset.range 10 := by simp *,
    lift c1 to finset.range 10 using h_c1,
    have h_c2 : c2 ∈ finset.range 10 := by simp *,
    lift c2 to finset.range 10 using h_c2,
    -- TODO: still very slow
    fin_cases c1 ; fin_cases c2 ; subst_vars ; norm_num * at *
  },
  have h34_options : c3 = 5 ∧ c4 = 6,
  {
    -- TODO: interval_cases hits a deterministic timeout on ⬝ < 10
    have h_c3 : c3 ∈ finset.range 10 := by simp *,
    lift c3 to finset.range 10 using h_c3,
    have h_c4 : c4 ∈ finset.range 10 := by simp *,
    lift c4 to finset.range 10 using h_c4,
    -- TODO: still very slow
    fin_cases c3 ; fin_cases c4 ; subst_vars ; norm_num * at *
  },
  cases_matching* [_ ∨ _, _ ∧ _] ; simp * at *
end


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

import tactic -- imports all the Lean tactics

/-!

# Sets in Lean, example sheet 4 : exists (`∃`)

In this sheet we learn how to manipulate `∃` in Lean. We will see
statements of the form `∃ x, x ∈ A`. We will need to learn two new
tactics -- one for making progress when the goal is `⊢ ∃ x, x ∈ A`,
and one for making progress when we have a hypothesis `h : ∃ x, x ∈ A`.

Now we have `∃` and `∀`, and `∈` and `∉`, we can finally get going
with some harder levels.

## New tactics you will need to know

`cases` or `rcases` -- to get the `x` from a hypothesis `h : ∃ x, ...`
`use` -- to make progress on goals of the form `⊢ ∃ x, ...`

### The `cases` tactic

We've seen this tactic before to take apart `h : P ∧ Q`. We can also
use it to take apart `h : ∃ t : X, F t`: if `h` is such a hypothesis
then `cases h with x hx,` will give us `x : X` and `hx : F x`

### The `use` tactic

If we have a goal `⊢ ∃ x : X, F x` and a term `a : X` which we know
will work, then `use a` will change the goal to `F a`. By the way,
`use` tries `refl` so it might magically close goals early

-/

open set

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

example : x ∈ A → ∃ t, t ∈ A :=
begin
  sorry
end

example : (∀ x, x ∈ A) ↔ ¬ (∃ x, x ∉ A) :=
begin
  sorry
end

example : (∃ x, x ∈ A) ↔ ¬ (∀ x, x ∉ A) :=
begin
  sorry
end


section propositional

variables P Q R : Prop

------------------------------------------------
-- Proposições de dupla negaço:
------------------------------------------------

theorem doubleneg_intro :
  P → ¬¬P  :=
begin
  intros hp notp,
  contradiction,

end

theorem doubleneg_elim :
  ¬¬P → P  :=
begin
  intro notnotp,
  by_contradiction notp,
  contradiction,

end

theorem doubleneg_law :
  ¬¬P ↔ P  :=
begin
  split,
  exact doubleneg_elim P,
  exact doubleneg_intro P,

end

------------------------------------------------
-- Comutatividade dos ∨,∧:
------------------------------------------------

theorem disj_comm :
  (P ∨ Q) → (Q ∨ P)  :=
begin
  intro PouQ,
  cases PouQ with hp hq,

  right,
  exact hp,

  left,
  exact hq,
end

theorem conj_comm :
  (P ∧ Q) → (Q ∧ P)  :=
begin
  intro PandQ,
  cases PandQ with hp hq,

  split,
  exact hq,
  exact hp,
end

------------------------------------------------
-- Proposições de interdefinabilidade dos →,∨:
------------------------------------------------

theorem impl_as_disj_converse :
  (¬P ∨ Q) → (P → Q)  :=
begin
  intro notPorQ,
  cases notPorQ with notp q,

  intro p,
  contradiction,

  intro p,
  exact q,

end

theorem disj_as_impl :
  (P ∨ Q) → (¬P → Q)  :=
begin
  intro PorQ,
  cases PorQ with p q,

  intro notp,
  contradiction,

  intro notq,
  exact q,

end

------------------------------------------------
-- Proposições de contraposição:
------------------------------------------------

theorem impl_as_contrapositive :
  (P → Q) → (¬Q → ¬P)  :=
begin
  intro PthenQ,
  intro notQ,
  intro p,

  have q : Q := PthenQ p,
  contradiction

end

theorem impl_as_contrapositive_converse :
  (¬Q → ¬P) → (P → Q)  :=
begin

  intro notQthennotP,
  intro p,

  by_cases h: Q,
  exact h,

  have notP : ¬P := notQthennotP h,
  contradiction,

end

theorem contrapositive_law :
  (P → Q) ↔ (¬Q → ¬P)  :=
begin
  split,
  exact impl_as_contrapositive P Q,
  exact impl_as_contrapositive_converse P Q,
end

------------------------------------------------
-- A irrefutabilidade do LEM:
------------------------------------------------

theorem lem_irrefutable :
  ¬¬(P∨¬P)  :=
begin
  intro notlem,
  apply notlem, -- pois notlem <==> (lem => boom); troca alvo
  right,
  intro p,
  apply notlem,
  left,
  exact p,

end

------------------------------------------------
-- A lei de Peirce
------------------------------------------------

theorem peirce_law_weak :
  ((P → Q) → P) → ¬¬P  :=
begin
  intro first,
  intro notp,
  apply notp,
  apply first,
  intro p,
  contradiction,

end

------------------------------------------------
-- Proposições de interdefinabilidade dos ∨,∧:
------------------------------------------------

theorem disj_as_negconj :
  P∨Q → ¬(¬P∧¬Q)  :=
begin
  intro PorQ,
  cases PorQ with p q,

  intro npANDnq,
  cases npANDnq with np nq,
  contradiction,

  intro npANDnq,
  cases npANDnq with np nq,
  contradiction,

end

theorem conj_as_negdisj :
  P∧Q → ¬(¬P∨¬Q)  :=
begin
  intro pandq,
  intro npornq,
  cases pandq with p q,

  cases npornq,

  contradiction,
  contradiction,

end

------------------------------------------------
-- As leis de De Morgan para ∨,∧:
------------------------------------------------

theorem demorgan_disj :
  ¬(P∨Q) → (¬P ∧ ¬Q)  :=
begin
  intro notPorQ,
  split,

  intro p,
  apply notPorQ,
  left,
  exact p,

  intro q,
  apply notPorQ,
  right,
  exact q,

end

theorem demorgan_disj_converse :
  (¬P ∧ ¬Q) → ¬(P∨Q)  :=
begin
  intro h,
  cases h with np nq,
  intro porq,

  cases porq with p q,
  contradiction,
  contradiction,

end

theorem demorgan_conj :
  ¬(P∧Q) → (¬Q ∨ ¬P)  :=
begin
  intro h,
  by_contradiction j,

  apply j,
  left,
  intro q,

  apply j,
  right,
  intro p,

  apply h,
  split,

  exact p,
  exact q,

end

theorem demorgan_conj_converse :
  (¬Q ∨ ¬P) → ¬(P∧Q)  :=
begin
  intro notqORnotp,
  intro notPandQ,
  cases notPandQ with p q,
  cases notqORnotp with notq or notp,
  contradiction,
  contradiction,

end

theorem demorgan_conj_law :
  ¬(P∧Q) ↔ (¬Q ∨ ¬P)  :=
begin
  split,
  exact demorgan_conj P Q,
  exact demorgan_conj_converse P Q,
end

theorem demorgan_disj_law :
  ¬(P∨Q) ↔ (¬P ∧ ¬Q)  :=
begin
  split,
  exact demorgan_disj P Q,
  exact demorgan_disj_converse P Q,
end

------------------------------------------------
-- Proposições de distributividade dos ∨,∧:
------------------------------------------------

theorem distr_conj_disj :
  P∧(Q∨R) → (P∧Q)∨(P∧R)  :=
begin
  intro h,
  cases h with p QorR,
  cases QorR with q r,

  left,
  split,
    exact p,
    exact q,

  right,
  split,
    exact p,
    exact r,

end

theorem distr_conj_disj_converse :
  (P∧Q)∨(P∧R) → P∧(Q∨R)  :=
begin
  intro h,
  split,

  cases h with l r,
    exact l.left,
    exact r.left,

  cases h with l r,
    left,
    exact l.right,

    right,
    exact r.right,

end

theorem distr_disj_conj :
  P∨(Q∧R) → (P∨Q)∧(P∨R)  :=
begin
  intro h,
  split,

  cases h with p QandR,
    left,
    exact p,

    right,
    exact QandR.left,

  cases h with p QandR,
    left,
    exact p,

    right,
    exact QandR.right,

end

theorem distr_disj_conj_converse :
  (P∨Q)∧(P∨R) → P∨(Q∧R)  :=
begin
  intro h,

  cases h with l r,
  cases r with p r,
  left,
  exact p,
  cases l with p q,
  left,
  exact p,
  right,
  split,
  exact q,
  exact r,

end

------------------------------------------------
-- Currificação
------------------------------------------------

theorem curry_prop :
  ((P∧Q)→R) → (P→(Q→R))  :=
begin
  intro h,
  intros p q,
  apply h,
  split,
  exact p,
  exact q

end

theorem uncurry_prop :
  (P→(Q→R)) → ((P∧Q)→R)  :=
begin
  intros h PandQ,
  cases PandQ with p q,
  have qr : Q→R := h p,
  have r : R := qr q,
  exact r,

end

------------------------------------------------
-- Reflexividade da →:
------------------------------------------------

theorem impl_refl :
  P → P  :=
begin
  intro p,
  exact p,
end

------------------------------------------------
-- Weakening and contraction:
------------------------------------------------

theorem weaken_disj_right :
  P → (P∨Q)  :=
begin
  intro p,
  left,
  exact p,
end

theorem weaken_disj_left :
  Q → (P∨Q)  :=
begin
  intro q,
  right,
  exact q,
end

theorem weaken_conj_right :
  (P∧Q) → P  :=
begin
  intro pq,
  exact pq.left,

end

theorem weaken_conj_left :
  (P∧Q) → Q  :=
begin
  intro pq,
  exact pq.right,
end

theorem conj_idempot :
  (P∧P) ↔ P :=
begin
  split,

  intro pp,
  exact pp.left,

  intro p,
  split,
  exact p,
  exact p,

end

theorem disj_idempot :
  (P∨P) ↔ P  :=
begin
  split,

  intro pp,
  cases pp with p p,
  exact p,
  exact p,

  intro p,
  left,
  exact p,

end

end propositional

----------------------------------------------------------------

section predicate

variable U : Type
variables P Q : U -> Prop

------------------------------------------------
-- As leis de De Morgan para ∃,∀:
------------------------------------------------

theorem demorgan_exists :
  ¬(∃x, P x) → (∀x, ¬P x)  :=
begin
  intro notx,
  intro x,
  intro px,

  apply notx,
  existsi x,
  exact px,
end

theorem demorgan_exists_converse :
  (∀x, ¬P x) → ¬(∃x, P x)  :=
begin
  intro fallxnotp,
  intro notxpx,

  cases notxpx with x px,
  have a := fallxnotp x,
  contradiction,

end

theorem demorgan_forall : --feitiço
  ¬(∀x, P x) → (∃x, ¬P x)  :=
begin
  intro notpx,
  by_contradiction NEnpx,

  apply notpx,
  intro x,

  by_contradiction notpx,
  apply NEnpx,
  existsi x,
  exact notpx,

end

theorem demorgan_forall_converse :
  (∃x, ¬P x) → ¬(∀x, P x)  :=
begin
  intro enpx,
  cases enpx with x notpx,
  intro allpx,
  have a := allpx x,
  contradiction,

end

theorem demorgan_forall_law :
  ¬(∀x, P x) ↔ (∃x, ¬P x)  :=
begin
  split,
  exact demorgan_forall U P,
  exact demorgan_forall_converse U P,

end

theorem demorgan_exists_law :
  ¬(∃x, P x) ↔ (∀x, ¬P x)  :=
begin
  split,
  exact demorgan_exists U P,
  exact demorgan_exists_converse U P,
end

------------------------------------------------
-- Proposições de interdefinabilidade dos ∃,∀:
------------------------------------------------

theorem exists_as_neg_forall :
  (∃x, P x) → ¬(∀x, ¬P x)  :=
begin
  intro expx,
  intro allnotpx,

  cases expx with x px,
  have notpx := allnotpx x,
  contradiction,

end

theorem forall_as_neg_exists :
  (∀x, P x) → ¬(∃x, ¬P x)  :=
begin
  intro allpx,
  intro existnotpx,

  cases existnotpx with x notpx,
  have px := allpx x,
  contradiction,

end

theorem forall_as_neg_exists_converse : -- feitiço
  ¬(∃x, ¬P x) → (∀x, P x)  :=
begin
  intro Nnpx,
  intro x,
  by_contradiction px,

  apply Nnpx,
  existsi x,
  exact px,
end

theorem exists_as_neg_forall_converse : --feitiço
  ¬(∀x, ¬P x) → (∃x, P x)  :=
begin
  intro notallnotpx,
  by_contradiction NEpx,

  apply notallnotpx,
  intro x,
  intro px,

  apply NEpx,
  existsi x,
  exact px,

end

theorem forall_as_neg_exists_law :
  (∀x, P x) ↔ ¬(∃x, ¬P x)  :=
begin
  split,
  exact forall_as_neg_exists U P,
  exact forall_as_neg_exists_converse U P,

end

theorem exists_as_neg_forall_law :
  (∃x, P x) ↔ ¬(∀x, ¬P x)  :=
begin
  split,
  exact exists_as_neg_forall U P,
  exact exists_as_neg_forall_converse U P,
end

------------------------------------------------
--  Proposições de distributividade de quantificadores:
------------------------------------------------

theorem exists_conj_as_conj_exists :
  (∃x, P x ∧ Q x) → (∃x, P x) ∧ (∃x, Q x)  :=
begin
  intro pxandqx,
  cases pxandqx with x pxandqx,
  cases pxandqx with px qx,

  split,
  existsi x,
  exact px,

  existsi x,
  exact qx,

end

theorem exists_disj_as_disj_exists :
  (∃x, P x ∨ Q x) → (∃x, P x) ∨ (∃x, Q x)  :=
begin
  intro pxorqx,
  cases pxorqx with x a,

  cases a with px qx,
  left,
  existsi x,
  exact px,

  right,
  existsi x,
  exact qx,

end

theorem exists_disj_as_disj_exists_converse :
  (∃x, P x) ∨ (∃x, Q x) → (∃x, P x ∨ Q x)  :=
begin
  intro h,
  cases h with l r,

  cases l with x px,

  existsi x,
  left,
  exact px,

  cases r with x qx,

  existsi x,
  right,
  exact qx,

end

theorem forall_conj_as_conj_forall :
  (∀x, P x ∧ Q x) → (∀x, P x) ∧ (∀x, Q x)  :=
begin
  intro h,
  split,

  intro x,
  have props := h x,
  cases props with px qx,
  exact px,

  intro x,
  have props := h x,
  cases props with px qx,
  exact qx,

end

theorem forall_conj_as_conj_forall_converse :
  (∀x, P x) ∧ (∀x, Q x) → (∀x, P x ∧ Q x)  :=
begin
  intro h,
  cases h with l r,
  intro x,
  have px := l x,
  have qx := r x,

  split,
  exact px,
  exact qx,
end

theorem forall_disj_as_disj_forall_converse :
  (∀x, P x) ∨ (∀x, Q x) → (∀x, P x ∨ Q x)  :=
begin
  intro h,
  intro x,

  cases h with l r,

  have px := l x,
  left,
  exact px,

  have qx := r x,
  right,
  exact qx,

end

/- NOT THEOREMS --------------------------------

theorem forall_disj_as_disj_forall :
  (∀x, P x ∨ Q x) → (∀x, P x) ∨ (∀x, Q x)  :=
begin
end

theorem exists_conj_as_conj_exists_converse :
  (∃x, P x) ∧ (∃x, Q x) → (∃x, P x ∧ Q x)  :=
begin
end

---------------------------------------------- -/

end predicate


import data.real.pi

open_locale real

example : (⋃ (n : ℤ), set.Ioo (n * (2 * π) - (π / 2) : ℝ) (n * (2 * π) + (π / 2) : ℝ)) ∪
  (⋃ (n : ℤ), set.Icc (n * (2 * π) + (π / 2) : ℝ) (n * (2 * π) + (3 * π/2) : ℝ)) = set.univ :=
begin
  rw set.eq_univ_iff_forall,
  intro x,
end

lemma cos_pos_iff (t : ℝ) : real.cos t > 0 ↔
  t ∈ ⋃ (n : ℤ), set.Ioo (n * (2 * π) - (π / 2) : ℝ) (n * (2 * π) + (π / 2) : ℝ) :=
sorry
-- begin
--   split,
--   { sorry },
--   { rintros ⟨V, ⟨n, rfl⟩, ht⟩,
--      dsimp at ht,
--      have h₁ : real.cos t = real.cos (t - n * (2 * π)),
--      { rw real.cos_sub_int_mul_two_pi },
--      have h₂ : t - n * (2 * π) ∈ set.Ioo (-(π/2)) (π/2),
--      { cases ht, split; linarith },
--      rw h₁,
--      apply real.cos_pos_of_mem_Ioo h₂, }
-- end

-- #check div_div_div_div_eq
-- #check pow_mul
-- -- #check mul_assoc
-- #check list.append_assoc

-- #print notation +
-- #print notation ++


/-
Copyright (c) 2020 Aaron Anderson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Aaron Anderson
-/
import algebra.gcd_monoid.finset
import data.polynomial.field_division
import data.polynomial.erase_lead
import data.polynomial.cancel_leads

/-!
# GCD structures on polynomials

Definitions and basic results about polynomials over GCD domains, particularly their contents
and primitive polynomials.

## Main Definitions
Let `p : polynomial R`.
 - `p.content` is the `gcd` of the coefficients of `p`.
 - `p.is_primitive` indicates that `p.content = 1`.

## Main Results
 - `polynomial.content_mul`:
  If `p q : polynomial R`, then `(p * q).content = p.content * q.content`.
 - `polynomial.normalized_gcd_monoid`:
  The polynomial ring of a GCD domain is itself a GCD domain.

-/

namespace polynomial

section primitive

variables {R : Type*} [comm_semiring R]

/-- A polynomial is primitive when the only constant polynomials dividing it are units -/
def is_primitive (p : polynomial R) : Prop :=
∀ (r : R), C r ∣ p → is_unit r

lemma is_primitive_iff_is_unit_of_C_dvd {p : polynomial R} :
  p.is_primitive ↔ ∀ (r : R), C r ∣ p → is_unit r :=
iff.rfl

@[simp]
lemma is_primitive_one : is_primitive (1 : polynomial R) :=
λ r h, is_unit_C.mp (is_unit_of_dvd_one (C r) h)

lemma monic.is_primitive {p : polynomial R} (hp : p.monic) : p.is_primitive :=
begin
  rintros r ⟨q, h⟩,
  exact is_unit_of_mul_eq_one r (q.coeff p.nat_degree) (by rwa [←coeff_C_mul, ←h]),
end

lemma is_primitive.ne_zero [nontrivial R] {p : polynomial R} (hp : p.is_primitive) : p ≠ 0 :=
begin
  rintro rfl,
  exact (hp 0 (dvd_zero (C 0))).ne_zero rfl,
end

end primitive

variables {R : Type*} [comm_ring R] [is_domain R]

section normalized_gcd_monoid
variable [normalized_gcd_monoid R]

/-- `p.content` is the `gcd` of the coefficients of `p`. -/
def content (p : polynomial R) : R := (p.support).gcd p.coeff

lemma content_dvd_coeff {p : polynomial R} (n : ℕ) : p.content ∣ p.coeff n :=
begin
  by_cases h : n ∈ p.support,
  { apply finset.gcd_dvd h },
  rw [mem_support_iff, not_not] at h,
  rw h,
  apply dvd_zero,
end

@[simp] lemma content_C {r : R} : (C r).content = normalize r :=
begin
  rw content,
  by_cases h0 : r = 0,
  { simp [h0] },
  have h : (C r).support = {0} := support_monomial _ _ h0,
  simp [h],
end

@[simp] lemma content_zero : content (0 : polynomial R) = 0 :=
by rw [← C_0, content_C, normalize_zero]

@[simp] lemma content_one : content (1 : polynomial R) = 1 :=
by rw [← C_1, content_C, normalize_one]

lemma content_X_mul {p : polynomial R} : content (X * p) = content p :=
begin
  rw [content, content, finset.gcd_def, finset.gcd_def],
  refine congr rfl _,
  have h : (X * p).support = p.support.map ⟨nat.succ, nat.succ_injective⟩,
  { ext a,
    simp only [exists_prop, finset.mem_map, function.embedding.coe_fn_mk, ne.def,
      mem_support_iff],
    cases a,
    { simp [coeff_X_mul_zero, nat.succ_ne_zero] },
    rw [mul_comm, coeff_mul_X],
    split,
    { intro h,
      use a,
      simp [h] },
    { rintros ⟨b, ⟨h1, h2⟩⟩,
      rw ← nat.succ_injective h2,
      apply h1 } },
  rw h,
  simp only [finset.map_val, function.comp_app, function.embedding.coe_fn_mk, multiset.map_map],
  refine congr (congr rfl _) rfl,
  ext a,
  rw mul_comm,
  simp [coeff_mul_X],
end

@[simp] lemma content_X_pow {k : ℕ} : content ((X : polynomial R) ^ k) = 1 :=
begin
  induction k with k hi,
  { simp },
  rw [pow_succ, content_X_mul, hi]
end

@[simp] lemma content_X : content (X : polynomial R) = 1 :=
by { rw [← mul_one X, content_X_mul, content_one] }

lemma content_C_mul (r : R) (p : polynomial R) : (C r * p).content = normalize r * p.content :=
begin
  by_cases h0 : r = 0, { simp [h0] },
  rw content, rw content, rw ← finset.gcd_mul_left,
  refine congr (congr rfl _) _; ext; simp [h0, mem_support_iff]
end

@[simp] lemma content_monomial {r : R} {k : ℕ} : content (monomial k r) = normalize r :=
by { rw [monomial_eq_C_mul_X, content_C_mul, content_X_pow, mul_one] }

lemma content_eq_zero_iff {p : polynomial R} : content p = 0 ↔ p = 0 :=
begin
  rw [content, finset.gcd_eq_zero_iff],
  split; intro h,
  { ext n,
    by_cases h0 : n ∈ p.support,
    { rw [h n h0, coeff_zero], },
    { rw mem_support_iff at h0,
      push_neg at h0,
      simp [h0] } },
  { intros x h0,
    simp [h] }
end

@[simp] lemma normalize_content {p : polynomial R} : normalize p.content = p.content :=
finset.normalize_gcd

lemma content_eq_gcd_range_of_lt (p : polynomial R) (n : ℕ) (h : p.nat_degree < n) :
  p.content = (finset.range n).gcd p.coeff :=
begin
  apply dvd_antisymm_of_normalize_eq normalize_content finset.normalize_gcd,
  { rw finset.dvd_gcd_iff,
    intros i hi,
    apply content_dvd_coeff _ },
  { apply finset.gcd_mono,
    intro i,
    simp only [nat.lt_succ_iff, mem_support_iff, ne.def, finset.mem_range],
    contrapose!,
    intro h1,
    apply coeff_eq_zero_of_nat_degree_lt (lt_of_lt_of_le h h1), }
end

lemma content_eq_gcd_leading_coeff_content_erase_lead (p : polynomial R) :
  p.content = gcd_monoid.gcd p.leading_coeff (erase_lead p).content :=
begin
  by_cases h : p = 0,
  { simp [h] },
  rw [← leading_coeff_eq_zero, leading_coeff, ← ne.def, ← mem_support_iff] at h,
  rw [content, ← finset.insert_erase h, finset.gcd_insert, leading_coeff, content,
    erase_lead_support],
  refine congr rfl (finset.gcd_congr rfl (λ i hi, _)),
  rw finset.mem_erase at hi,
  rw [erase_lead_coeff, if_neg hi.1],
end

lemma dvd_content_iff_C_dvd {p : polynomial R} {r : R} : r ∣ p.content ↔ C r ∣ p :=
begin
  rw C_dvd_iff_dvd_coeff,
  split,
  { intros h i,
    apply h.trans (content_dvd_coeff _) },
  { intro h,
    rw [content, finset.dvd_gcd_iff],
    intros i hi,
    apply h i }
end

lemma C_content_dvd (p : polynomial R) : C p.content ∣ p :=
dvd_content_iff_C_dvd.1 dvd_rfl

lemma is_primitive_iff_content_eq_one {p : polynomial R} : p.is_primitive ↔ p.content = 1 :=
begin
  rw [←normalize_content, normalize_eq_one, is_primitive],
  simp_rw [←dvd_content_iff_C_dvd],
  exact ⟨λ h, h p.content (dvd_refl p.content), λ h r hdvd, is_unit_of_dvd_unit hdvd h⟩,
end

lemma is_primitive.content_eq_one {p : polynomial R} (hp : p.is_primitive) : p.content = 1 :=
is_primitive_iff_content_eq_one.mp hp

open_locale classical
noncomputable theory

section prim_part

/-- The primitive part of a polynomial `p` is the primitive polynomial gained by dividing `p` by
  `p.content`. If `p = 0`, then `p.prim_part = 1`.  -/
def prim_part (p : polynomial R) : polynomial R :=
if p = 0 then 1 else classical.some (C_content_dvd p)

lemma eq_C_content_mul_prim_part (p : polynomial R) : p = C p.content * p.prim_part :=
begin
  by_cases h : p = 0, { simp [h] },
  rw [prim_part, if_neg h, ← classical.some_spec (C_content_dvd p)],
end

@[simp]
lemma prim_part_zero : prim_part (0 : polynomial R) = 1 := if_pos rfl

lemma is_primitive_prim_part (p : polynomial R) : p.prim_part.is_primitive :=
begin
  by_cases h : p = 0, { simp [h] },
  rw ← content_eq_zero_iff at h,
  rw is_primitive_iff_content_eq_one,
  apply mul_left_cancel₀ h,
  conv_rhs { rw [p.eq_C_content_mul_prim_part, mul_one, content_C_mul, normalize_content] }
end

lemma content_prim_part (p : polynomial R) : p.prim_part.content = 1 :=
p.is_primitive_prim_part.content_eq_one

lemma prim_part_ne_zero (p : polynomial R) : p.prim_part ≠ 0 := p.is_primitive_prim_part.ne_zero

lemma nat_degree_prim_part (p : polynomial R) : p.prim_part.nat_degree = p.nat_degree :=
begin
  by_cases h : C p.content = 0,
  { rw [C_eq_zero, content_eq_zero_iff] at h, simp [h] },
  conv_rhs { rw [p.eq_C_content_mul_prim_part,
    nat_degree_mul h p.prim_part_ne_zero, nat_degree_C, zero_add] },
end

@[simp]
lemma is_primitive.prim_part_eq {p : polynomial R} (hp : p.is_primitive) : p.prim_part = p :=
by rw [← one_mul p.prim_part, ← C_1, ← hp.content_eq_one, ← p.eq_C_content_mul_prim_part]

lemma is_unit_prim_part_C (r : R) : is_unit (C r).prim_part :=
begin
  by_cases h0 : r = 0,
  { simp [h0] },
  unfold is_unit,
  refine ⟨⟨C ↑(norm_unit r)⁻¹, C ↑(norm_unit r),
    by rw [← ring_hom.map_mul, units.inv_mul, C_1],
    by rw [← ring_hom.map_mul, units.mul_inv, C_1]⟩, _⟩,
  rw [← normalize_eq_zero, ← C_eq_zero] at h0,
  apply mul_left_cancel₀ h0,
  conv_rhs { rw [← content_C, ← (C r).eq_C_content_mul_prim_part], },
  simp only [units.coe_mk, normalize_apply, ring_hom.map_mul],
  rw [mul_assoc, ← ring_hom.map_mul, units.mul_inv, C_1, mul_one],
end

lemma prim_part_dvd (p : polynomial R) : p.prim_part ∣ p :=
dvd.intro_left (C p.content) p.eq_C_content_mul_prim_part.symm

end prim_part

lemma gcd_content_eq_of_dvd_sub {a : R} {p q : polynomial R} (h : C a ∣ p - q) :
  gcd_monoid.gcd a p.content = gcd_monoid.gcd a q.content :=
begin
  rw content_eq_gcd_range_of_lt p (max p.nat_degree q.nat_degree).succ
    (lt_of_le_of_lt (le_max_left _ _) (nat.lt_succ_self _)),
  rw content_eq_gcd_range_of_lt q (max p.nat_degree q.nat_degree).succ
    (lt_of_le_of_lt (le_max_right _ _) (nat.lt_succ_self _)),
  apply finset.gcd_eq_of_dvd_sub,
  intros x hx,
  cases h with w hw,
  use w.coeff x,
  rw [← coeff_sub, hw, coeff_C_mul]
end

lemma content_mul_aux {p q : polynomial R} :
  gcd_monoid.gcd (p * q).erase_lead.content p.leading_coeff =
  gcd_monoid.gcd (p.erase_lead * q).content p.leading_coeff :=
begin
  rw [gcd_comm (content _) _, gcd_comm (content _) _],
  apply gcd_content_eq_of_dvd_sub,
  rw [← self_sub_C_mul_X_pow, ← self_sub_C_mul_X_pow, sub_mul, sub_sub, add_comm, sub_add,
    sub_sub_cancel, leading_coeff_mul, ring_hom.map_mul, mul_assoc, mul_assoc],
  apply dvd_sub (dvd.intro _ rfl) (dvd.intro _ rfl),
end

@[simp]
theorem content_mul {p q : polynomial R} : (p * q).content = p.content * q.content :=
begin
  classical,
  suffices h : ∀ (n : ℕ) (p q : polynomial R), ((p * q).degree < n) →
    (p * q).content = p.content * q.content,
  { apply h,
    apply (lt_of_le_of_lt degree_le_nat_degree (with_bot.coe_lt_coe.2 (nat.lt_succ_self _))) },
  intro n,
  induction n with n ih,
  { intros p q hpq,
    rw [with_bot.coe_zero, nat.with_bot.lt_zero_iff, degree_eq_bot, mul_eq_zero] at hpq,
    rcases hpq with rfl | rfl; simp },
  intros p q hpq,
  by_cases p0 : p = 0, { simp [p0] },
  by_cases q0 : q = 0, { simp [q0] },
  rw [degree_eq_nat_degree (mul_ne_zero p0 q0), with_bot.coe_lt_coe, nat.lt_succ_iff_lt_or_eq,
    ← with_bot.coe_lt_coe, ← degree_eq_nat_degree (mul_ne_zero p0 q0), nat_degree_mul p0 q0] at hpq,
  rcases hpq with hlt | heq, { apply ih _ _ hlt },
  rw [← p.nat_degree_prim_part, ← q.nat_degree_prim_part, ← with_bot.coe_eq_coe, with_bot.coe_add,
    ← degree_eq_nat_degree p.prim_part_ne_zero, ← degree_eq_nat_degree q.prim_part_ne_zero] at heq,
  rw [p.eq_C_content_mul_prim_part, q.eq_C_content_mul_prim_part],
  suffices h : (q.prim_part * p.prim_part).content = 1,
  { rw [mul_assoc, content_C_mul, content_C_mul, mul_comm p.prim_part, mul_assoc, content_C_mul,
    content_C_mul, h, mul_one, content_prim_part, content_prim_part, mul_one, mul_one] },
  rw [← normalize_content, normalize_eq_one, is_unit_iff_dvd_one,
      content_eq_gcd_leading_coeff_content_erase_lead, leading_coeff_mul, gcd_comm],
  apply (gcd_mul_dvd_mul_gcd _ _ _).trans,
  rw [content_mul_aux, ih, content_prim_part, mul_one, gcd_comm,
      ← content_eq_gcd_leading_coeff_content_erase_lead, content_prim_part, one_mul,
      mul_comm q.prim_part, content_mul_aux, ih, content_prim_part, mul_one, gcd_comm,
      ← content_eq_gcd_leading_coeff_content_erase_lead, content_prim_part],
  { rw [← heq, degree_mul, with_bot.add_lt_add_iff_right],
    { apply degree_erase_lt p.prim_part_ne_zero },
    { rw [ne.def, degree_eq_bot],
      apply q.prim_part_ne_zero } },
  { rw [mul_comm, ← heq, degree_mul, with_bot.add_lt_add_iff_left],
    { apply degree_erase_lt q.prim_part_ne_zero },
    { rw [ne.def, degree_eq_bot],
      apply p.prim_part_ne_zero } }
end

theorem is_primitive.mul {p q : polynomial R} (hp : p.is_primitive) (hq : q.is_primitive) :
  (p * q).is_primitive :=
by rw [is_primitive_iff_content_eq_one, content_mul, hp.content_eq_one, hq.content_eq_one, mul_one]

@[simp]
theorem prim_part_mul {p q : polynomial R} (h0 : p * q ≠ 0) :
  (p * q).prim_part = p.prim_part * q.prim_part :=
begin
  rw [ne.def, ← content_eq_zero_iff, ← C_eq_zero] at h0,
  apply mul_left_cancel₀ h0,
  conv_lhs { rw [← (p * q).eq_C_content_mul_prim_part,
    p.eq_C_content_mul_prim_part, q.eq_C_content_mul_prim_part] },
  rw [content_mul, ring_hom.map_mul],
  ring,
end

lemma is_primitive.is_primitive_of_dvd {p q : polynomial R} (hp : p.is_primitive) (hdvd : q ∣ p) :
  q.is_primitive :=
begin
  rcases hdvd with ⟨r, rfl⟩,
  rw [is_primitive_iff_content_eq_one, ← normalize_content, normalize_eq_one, is_unit_iff_dvd_one],
  apply dvd.intro r.content,
  rwa [is_primitive_iff_content_eq_one, content_mul] at hp,
end

lemma is_primitive.dvd_prim_part_iff_dvd {p q : polynomial R}
  (hp : p.is_primitive) (hq : q ≠ 0) :
  p ∣ q.prim_part ↔ p ∣ q :=
begin
  refine ⟨λ h, h.trans (dvd.intro_left _ q.eq_C_content_mul_prim_part.symm), λ h, _⟩,
  rcases h with ⟨r, rfl⟩,
  apply dvd.intro _,
  rw [prim_part_mul hq, hp.prim_part_eq],
end

theorem exists_primitive_lcm_of_is_primitive {p q : polynomial R}
  (hp : p.is_primitive) (hq : q.is_primitive) :
  ∃ r : polynomial R, r.is_primitive ∧ (∀ s : polynomial R, p ∣ s ∧ q ∣ s ↔ r ∣ s) :=
begin
  classical,
  have h : ∃ (n : ℕ) (r : polynomial R), r.nat_degree = n ∧ r.is_primitive ∧ p ∣ r ∧ q ∣ r :=
    ⟨(p * q).nat_degree, p * q, rfl, hp.mul hq, dvd_mul_right _ _, dvd_mul_left _ _⟩,
  rcases nat.find_spec h with ⟨r, rdeg, rprim, pr, qr⟩,
  refine ⟨r, rprim, λ s, ⟨_, λ rs, ⟨pr.trans rs, qr.trans rs⟩⟩⟩,
  suffices hs : ∀ (n : ℕ) (s : polynomial R), s.nat_degree = n → (p ∣ s ∧ q ∣ s → r ∣ s),
  { apply hs s.nat_degree s rfl },
  clear s,
  by_contra con,
  push_neg at con,
  rcases nat.find_spec con with ⟨s, sdeg, ⟨ps, qs⟩, rs⟩,
  have s0 : s ≠ 0,
  { contrapose! rs, simp [rs] },
  have hs := nat.find_min' h ⟨_, s.nat_degree_prim_part, s.is_primitive_prim_part,
              (hp.dvd_prim_part_iff_dvd s0).2 ps, (hq.dvd_prim_part_iff_dvd s0).2 qs⟩,
  rw ← rdeg at hs,
  by_cases sC : s.nat_degree ≤ 0,
  { rw [eq_C_of_nat_degree_le_zero (le_trans hs sC), is_primitive_iff_content_eq_one,
      content_C, normalize_eq_one] at rprim,
    rw [eq_C_of_nat_degree_le_zero (le_trans hs sC), ← dvd_content_iff_C_dvd] at rs,
    apply rs rprim.dvd },
  have hcancel := nat_degree_cancel_leads_lt_of_nat_degree_le_nat_degree hs (lt_of_not_ge sC),
  rw sdeg at hcancel,
  apply nat.find_min con hcancel,
  refine ⟨_, rfl, ⟨dvd_cancel_leads_of_dvd_of_dvd pr ps, dvd_cancel_leads_of_dvd_of_dvd qr qs⟩,
      λ rcs, rs _⟩,
  rw ← rprim.dvd_prim_part_iff_dvd s0,
  rw [cancel_leads, tsub_eq_zero_iff_le.mpr hs, pow_zero, mul_one] at rcs,
  have h := dvd_add rcs (dvd.intro_left _ rfl),
  have hC0 := rprim.ne_zero,
  rw [ne.def, ← leading_coeff_eq_zero, ← C_eq_zero] at hC0,
  rw [sub_add_cancel, ← rprim.dvd_prim_part_iff_dvd (mul_ne_zero hC0 s0)] at h,
  rcases is_unit_prim_part_C r.leading_coeff with ⟨u, hu⟩,
  apply h.trans (associated.symm ⟨u, _⟩).dvd,
  rw [prim_part_mul (mul_ne_zero hC0 s0), hu, mul_comm],
end

lemma dvd_iff_content_dvd_content_and_prim_part_dvd_prim_part
  {p q : polynomial R} (hq : q ≠ 0) :
  p ∣ q ↔ p.content ∣ q.content ∧ p.prim_part ∣ q.prim_part :=
begin
  split; intro h,
  { rcases h with ⟨r, rfl⟩,
    rw [content_mul, p.is_primitive_prim_part.dvd_prim_part_iff_dvd hq],
    exact ⟨dvd.intro _ rfl, p.prim_part_dvd.trans (dvd.intro _ rfl)⟩ },
  { rw [p.eq_C_content_mul_prim_part, q.eq_C_content_mul_prim_part],
    exact mul_dvd_mul (ring_hom.map_dvd C h.1) h.2 }
end

@[priority 100]
instance normalized_gcd_monoid : normalized_gcd_monoid (polynomial R) :=
normalized_gcd_monoid_of_exists_lcm $ λ p q, begin
  rcases exists_primitive_lcm_of_is_primitive p.is_primitive_prim_part q.is_primitive_prim_part
    with ⟨r, rprim, hr⟩,
  refine ⟨C (lcm p.content q.content) * r, λ s, _⟩,
  by_cases hs : s = 0,
  { simp [hs] },
  by_cases hpq : C (lcm p.content q.content) = 0,
  { rw [C_eq_zero, lcm_eq_zero_iff, content_eq_zero_iff, content_eq_zero_iff] at hpq,
    rcases hpq with hpq | hpq; simp [hpq, hs] },
  iterate 3 { rw dvd_iff_content_dvd_content_and_prim_part_dvd_prim_part hs },
  rw [content_mul, rprim.content_eq_one, mul_one, content_C, normalize_lcm, lcm_dvd_iff,
    prim_part_mul (mul_ne_zero hpq rprim.ne_zero), rprim.prim_part_eq,
    is_unit.mul_left_dvd _ _ _ (is_unit_prim_part_C (lcm p.content q.content)), ← hr s.prim_part],
  tauto,
end

lemma degree_gcd_le_left {p : polynomial R} (hp : p ≠ 0) (q) : (gcd p q).degree ≤ p.degree :=
begin
  have := nat_degree_le_iff_degree_le.mp
    (nat_degree_le_of_dvd (gcd_dvd_left p q) hp),
  rwa degree_eq_nat_degree hp
end

lemma degree_gcd_le_right (p) {q : polynomial R} (hq : q ≠ 0) : (gcd p q).degree ≤ q.degree :=
by { rw [gcd_comm], exact degree_gcd_le_left hq p }

end normalized_gcd_monoid
end polynomial


/-
Copyright (c) 2021 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import set_theory.cardinal_ordinal

/-!
# Cardinality of continuum

In this file we define `cardinal.continuum` (notation: `𝔠`, localized in `cardinal`) to be `2 ^ ω`.
We also prove some `simp` lemmas about cardinal arithmetic involving `𝔠`.

## Notation

- `𝔠` : notation for `cardinal.continuum` in locale `cardinal`.
-/

namespace cardinal

universes u v

open_locale cardinal

/-- Cardinality of continuum. -/
def continuum : cardinal.{u} := 2 ^ omega.{u}

localized "notation `𝔠` := cardinal.continuum" in cardinal

@[simp] lemma two_power_omega : (2 ^ omega.{u} : cardinal.{u}) = 𝔠 := rfl

@[simp] lemma lift_continuum : lift.{v} continuum.{u} = 𝔠 :=
by rw [← two_power_omega, lift_two_power, lift_omega, two_power_omega]

/-!
### Inequalities
-/

lemma omega_lt_continuum : ω < 𝔠 := cantor ω

lemma omega_le_continuum : ω ≤ 𝔠 := omega_lt_continuum.le

lemma nat_lt_continuum (n : ℕ) : ↑n < 𝔠 := (nat_lt_omega n).trans omega_lt_continuum

lemma mk_set_nat : #(set ℕ) = 𝔠 := by simp

lemma continuum_pos : 0 < 𝔠 := nat_lt_continuum 0

lemma continuum_ne_zero : 𝔠 ≠ 0 := continuum_pos.ne'

lemma aleph_one_le_continuum : aleph 1 ≤ 𝔠 :=
by { rw ← succ_omega, exact succ_le.2 omega_lt_continuum }

/-!
### Addition
-/

@[simp] lemma omega_add_continuum : ω + 𝔠 = 𝔠 :=
add_eq_right omega_le_continuum omega_le_continuum

@[simp] lemma continuum_add_omega : 𝔠 + ω = 𝔠 :=
(add_comm _ _).trans omega_add_continuum

@[simp] lemma continuum_add_self : 𝔠 + 𝔠 = 𝔠 :=
add_eq_right omega_le_continuum le_rfl

@[simp] lemma nat_add_continuum (n : ℕ) : ↑n + 𝔠 = 𝔠 :=
add_eq_right omega_le_continuum (nat_lt_continuum n).le

@[simp] lemma continuum_add_nat (n : ℕ) : 𝔠 + n = 𝔠 :=
(add_comm _ _).trans (nat_add_continuum n)

/-!
### Multiplication
-/

@[simp] lemma continuum_mul_self : 𝔠 * 𝔠 = 𝔠 :=
mul_eq_left omega_le_continuum le_rfl continuum_ne_zero

@[simp] lemma continuum_mul_omega : 𝔠 * ω = 𝔠 :=
mul_eq_left omega_le_continuum omega_le_continuum omega_ne_zero

@[simp] lemma omega_mul_continuum : ω * 𝔠 = 𝔠 :=
(mul_comm _ _).trans continuum_mul_omega

@[simp] lemma nat_mul_continuum {n : ℕ} (hn : n ≠ 0) :
  ↑n * 𝔠 = 𝔠 :=
mul_eq_right omega_le_continuum (nat_lt_continuum n).le (nat.cast_ne_zero.2 hn)

@[simp] lemma continuum_mul_nat {n : ℕ} (hn : n ≠ 0) :
  𝔠 * n = 𝔠 :=
(mul_comm _ _).trans (nat_mul_continuum hn)

/-!
### Power
-/

@[simp] lemma omega_power_omega : omega.{u} ^ omega.{u} = 𝔠 :=
power_self_eq le_rfl

@[simp] lemma nat_power_omega {n : ℕ} (hn : 2 ≤ n) : (n ^ omega.{u} : cardinal.{u}) = 𝔠 :=
nat_power_eq le_rfl hn

@[simp] lemma continuum_power_omega : continuum.{u} ^ omega.{u} = 𝔠 :=
by rw [← two_power_omega, ← power_mul, mul_eq_left le_rfl le_rfl omega_ne_zero]

end cardinal