/-
Copyright (c) 2015 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura

Parity.
-/
import data.nat.power logic.identities

namespace nat
open decidable

definition even (n : nat) := n % 2 = 0

definition decidable_even [instance] : ∀ n, decidable (even n) :=
take n, !nat.has_decidable_eq

definition odd (n : nat) := ¬even n

definition decidable_odd [instance] : ∀ n, decidable (odd n) :=
take n, decidable_not

lemma even_of_dvd {n} : 2 ∣ n → even n :=
mod_eq_zero_of_dvd

lemma dvd_of_even {n} : even n → 2 ∣ n :=
dvd_of_mod_eq_zero

lemma not_odd_zero : ¬ odd 0 :=
dec_trivial

lemma even_zero : even 0 :=
dec_trivial

lemma odd_one : odd 1 :=
dec_trivial

lemma not_even_one : ¬ even 1 :=
dec_trivial

lemma odd_eq_not_even (n : nat) : odd n = ¬ even n :=
rfl

lemma odd_iff_not_even (n : nat) : odd n ↔ ¬ even n :=
!iff.refl

lemma odd_of_not_even {n} : ¬ even n → odd n :=
suppose ¬ even n,
iff.mpr !odd_iff_not_even this

lemma even_of_not_odd {n} : ¬ odd n → even n :=
suppose ¬ odd n,
not_not_elim (iff.mp (not_iff_not_of_iff !odd_iff_not_even) this)

lemma not_odd_of_even {n} : even n → ¬ odd n :=
suppose even n,
iff.mpr (not_iff_not_of_iff !odd_iff_not_even) (not_not_intro this)

lemma not_even_of_odd {n} : odd n → ¬ even n :=
suppose odd n,
iff.mp !odd_iff_not_even this

lemma odd_succ_of_even {n} : even n → odd (succ n) :=
suppose even n,
have n ≡ 0 [mod 2],       from this,
have n+1 ≡ 0+1 [mod 2],   from add_mod_eq_add_mod_right 1 this,
have h : n+1 ≡ 1 [mod 2], from this,
by_contradiction (suppose ¬ odd (succ n),
  have n+1 ≡ 0 [mod 2], from even_of_not_odd this,
  have 1 ≡ 0 [mod 2],   from eq.trans (eq.symm h) this,
  have 1 = 0,         from this,
  by contradiction)

lemma eq_1_of_ne_0_lt_2 : ∀ {n : nat}, n ≠ 0 → n < 2 → n = 1
| 0     h₁ h₂ := absurd rfl h₁
| 1     h₁ h₂ := rfl
| (n+2) h₁ h₂ := absurd (lt_of_succ_lt_succ (lt_of_succ_lt_succ h₂)) !not_lt_zero

lemma mod_eq_of_odd {n} : odd n → n % 2 = 1 :=
suppose odd n,
  have ¬ n % 2 = 0, from this,
  have n % 2 < 2,   from mod_lt n dec_trivial,
  eq_1_of_ne_0_lt_2 `¬ n % 2 = 0` `n % 2 < 2`

lemma odd_of_mod_eq {n} : n % 2 = 1 → odd n :=
suppose n % 2 = 1,
by_contradiction (suppose ¬ odd n,
  have n % 2 = 0, from even_of_not_odd this,
  by rewrite this at *; contradiction)

lemma even_succ_of_odd {n} : odd n → even (succ n) :=
suppose odd n,
  have n % 2 = 1 % 2,     from mod_eq_of_odd this,
  have (n+1) % 2 = 2 % 2, from add_mod_eq_add_mod_right 1 this,
  by rewrite mod_self at this; exact this

lemma odd_succ_succ_of_odd {n} : odd n → odd (succ (succ n)) :=
suppose odd n,
odd_succ_of_even (even_succ_of_odd this)

lemma even_succ_succ_of_even {n} : even n → even (succ (succ n)) :=
suppose even n,
even_succ_of_odd (odd_succ_of_even this)

lemma even_of_odd_succ {n} : odd (succ n) → even n :=
suppose odd (succ n),
by_contradiction (suppose ¬ even n,
  have odd n,         from odd_of_not_even this,
  have even (succ n), from even_succ_of_odd this,
  absurd this (not_even_of_odd `odd (succ n)`))

lemma odd_of_even_succ {n} : even (succ n) → odd n :=
suppose even (succ n),
by_contradiction (suppose ¬ odd n,
  have even n,       from even_of_not_odd this,
  have odd (succ n), from odd_succ_of_even this,
  absurd `even (succ n)` (not_even_of_odd this))

lemma even_of_even_succ_succ {n} : even (succ (succ n)) → even n :=
suppose even (n+2),
even_of_odd_succ (odd_of_even_succ this)

lemma odd_of_odd_succ_succ {n} : odd (succ (succ n)) → odd n :=
suppose odd (n+2),
odd_of_even_succ (even_of_odd_succ this)

lemma dvd_of_odd {n} : odd n → 2 ∣ n+1 :=
suppose odd n,
dvd_of_even (even_succ_of_odd this)

lemma odd_of_dvd {n} : 2 ∣ n+1 → odd n :=
suppose 2 ∣ n+1,
odd_of_even_succ (even_of_dvd this)

lemma even_two_mul : ∀ n, even (2 * n) :=
take n, even_of_dvd (dvd_mul_right 2 n)

lemma odd_two_mul_plus_one : ∀ n, odd (2 * n + 1) :=
take n, odd_succ_of_even (even_two_mul n)

lemma not_even_two_mul_plus_one : ∀ n, ¬ even (2 * n + 1) :=
take n, not_even_of_odd (odd_two_mul_plus_one n)

lemma not_odd_two_mul : ∀ n, ¬ odd (2 * n) :=
take n, not_odd_of_even (even_two_mul n)

lemma even_pred_of_odd : ∀ {n}, odd n → even (pred n)
| 0     h := absurd h not_odd_zero
| (n+1) h := even_of_odd_succ h

lemma even_or_odd : ∀ n, even n ∨ odd n :=
λ n, by_cases
  (λ h : even n,   or.inl h)
  (λ h : ¬ even n, or.inr (odd_of_not_even h))

lemma exists_of_even {n} : even n → ∃ k, n = 2*k :=
λ h, exists_eq_mul_right_of_dvd (dvd_of_even h)

lemma exists_of_odd : ∀ {n}, odd n → ∃ k, n = 2*k + 1
| 0 h     := absurd h not_odd_zero
| (n+1) h :=
  obtain k (hk : n = 2*k), from exists_of_even (even_of_odd_succ h),
  exists.intro k (by subst n)

lemma even_of_exists {n} : (∃ k, n = 2 * k) → even n :=
suppose ∃ k, n = 2 * k,
obtain k (hk : n = 2 * k), from this,
have 2 ∣ n, by subst n; apply dvd_mul_right,
even_of_dvd this

lemma odd_of_exists {n} : (∃ k, n = 2 * k + 1) → odd n :=
assume h, by_contradiction (λ hn,
  have even n, from even_of_not_odd hn,
  have ∃ k, n = 2 * k, from exists_of_even this,
  obtain k₁ (hk₁ : n = 2 * k₁ + 1), from h,
  obtain k₂ (hk₂ : n = 2 * k₂), from this,
  have (2 * k₁ + 1) % 2 = (2 * k₂) % 2, by rewrite [-hk₁, -hk₂],
  begin
    rewrite [mul_mod_right at this, add.comm at this, add_mul_mod_self_left at this],
    contradiction
  end)

lemma even_add_of_even_of_even {n m} : even n → even m → even (n+m) :=
suppose even n, suppose even m,
obtain k₁ (hk₁ : n = 2 * k₁), from exists_of_even `even n`,
obtain k₂ (hk₂ : m = 2 * k₂), from exists_of_even `even m`,
even_of_exists (exists.intro (k₁+k₂) (by rewrite [hk₁, hk₂, left_distrib]))

lemma even_add_of_odd_of_odd {n m} : odd n → odd m → even (n+m) :=
suppose odd n, suppose odd m,
have even (succ n + succ m),
  from even_add_of_even_of_even (even_succ_of_odd `odd n`) (even_succ_of_odd `odd m`),
have   even(succ (succ (n + m))), by rewrite [add_succ at this, succ_add at this]; exact this,
even_of_even_succ_succ this

lemma odd_add_of_even_of_odd {n m} : even n → odd m → odd (n+m) :=
suppose even n, suppose odd m,
have even (n + succ m), from even_add_of_even_of_even `even n` (even_succ_of_odd `odd m`),
odd_of_even_succ this

lemma odd_add_of_odd_of_even {n m} : odd n → even m → odd (n+m) :=
suppose odd n, suppose even m,
have odd (m+n), from odd_add_of_even_of_odd `even m` `odd n`,
by rewrite add.comm at this; exact this

lemma even_mul_of_even_left {n} (m) : even n → even (n*m) :=
suppose even n,
obtain k (hk : n = 2*k), from exists_of_even this,
even_of_exists (exists.intro (k*m) (by rewrite [hk, mul.assoc]))

lemma even_mul_of_even_right {n} (m) : even n → even (m*n) :=
suppose even n,
have even (n*m), from even_mul_of_even_left _ this,
by rewrite mul.comm at this; exact this

lemma odd_mul_of_odd_of_odd {n m} : odd n → odd m → odd (n*m) :=
suppose odd n, suppose odd m,
have even (n * succ m), from even_mul_of_even_right _ (even_succ_of_odd `odd m`),
have even (n * m + n),  by rewrite mul_succ at this; exact this,
by_contradiction (suppose ¬ odd (n*m),
  have even (n*m), from even_of_not_odd this,
  absurd `even (n * m + n)` (not_even_of_odd (odd_add_of_even_of_odd this `odd n`)))

lemma even_of_even_mul_self {n} : even (n * n) → even n :=
suppose even (n * n),
by_contradiction (suppose odd n,
  have odd (n * n), from odd_mul_of_odd_of_odd this this,
  show false, from this `even (n * n)`)

lemma odd_of_odd_mul_self {n} : odd (n * n) → odd n :=
suppose odd (n * n),
  suppose even n,
  have even (n * n), from !even_mul_of_even_left this,
  show false, from `odd (n * n)` this

lemma odd_pow {n m} (h : odd n) : odd (n^m) :=
nat.induction_on m
  (show odd (n^0), from dec_trivial)
  (take m, suppose odd (n^m),
    show odd (n^(m+1)), from odd_mul_of_odd_of_odd h this)

lemma even_pow {n m} (mpos : m > 0) (h : even n) : even (n^m) :=
have h₁ : ∀ m, even (n^succ m),
  from take m, nat.induction_on m
    (show even (n^1), by rewrite pow_one; apply h)
    (take m, suppose even (n^succ m),
      show even (n^(succ (succ m))), from !even_mul_of_even_left h),
obtain m' (h₂ : m = succ m'), from exists_eq_succ_of_pos mpos,
show even (n^m), by rewrite h₂; apply h₁

lemma odd_of_odd_pow {n m} (mpos : m > 0) (h : odd (n^m)) : odd n :=
suppose even n,
have even (n^m), from even_pow mpos this,
show false, from `odd (n^m)` this

lemma even_of_even_pow {n m} (h : even (n^m)) : even n :=
by_contradiction
  (suppose odd n,
    have odd (n^m), from odd_pow this,
    show false, from this `even (n^m)`)

lemma eq_of_div2_of_even {n m : nat} : n / 2 = m / 2 → (even n ↔ even m) → n = m :=
assume h₁ h₂,
 or.elim (em (even n))
   (suppose even n, or.elim (em (even m))
     (suppose even m,
      obtain w₁ (hw₁ : n = 2*w₁), from exists_of_even `even n`,
      obtain w₂ (hw₂ : m = 2*w₂), from exists_of_even `even m`,
      begin
        substvars, rewrite [mul.comm 2 w₁ at h₁, mul.comm 2 w₂ at h₁,
                            *nat.mul_div_cancel _ (dec_trivial : 2 > 0) at h₁, h₁]
      end)
     (suppose odd m,  absurd `odd m` (not_odd_of_even (iff.mp h₂ `even n`))))
   (suppose odd n,  or.elim (em (even m))
     (suppose even m, absurd `odd n` (not_odd_of_even (iff.mpr h₂ `even m`)))
     (suppose odd m,
      have d : 1 / 2 = (0:nat),   from dec_trivial,
      obtain w₁ (hw₁ : n = 2*w₁ + 1), from exists_of_odd `odd n`,
      obtain w₂ (hw₂ : m = 2*w₂ + 1), from exists_of_odd `odd m`,
      begin
        substvars,
        rewrite [add.comm at h₁, add_mul_div_self_left _ _ (dec_trivial : 2 > 0) at h₁, d at h₁,
                 zero_add at h₁],
        rewrite [add.comm at h₁, add_mul_div_self_left _ _ (dec_trivial : 2 > 0) at h₁, d at h₁,
                 zero_add at h₁],
        rewrite h₁
      end))
end nat


-- Classical Logic

open classical

variables p q : Prop
#check em p

theorem dne {p : Prop} (h : ¬¬ p) : p :=
or.elim (em p)
  (assume hp : p, hp)
  (assume hnp : ¬ p, absurd hnp h)

-- theorem converse {p : Prop} : p ∨ ¬ p :=
-- stopped here - no idea how to prove this!

-- There is a classical proof in Lemmon, result 44, p52!
-- As a warm-up for converting natural deduction proofs
-- into Lean proofs, try result 23 on p27.

theorem lemmon_23 {p : Prop} (h : p → ¬ p) : ¬ p :=
assume hp : p,
have hnp : ¬ p, from h hp,
show false, from hnp hp

#check @lemmon_23 p
#print lemmon_23

-- Write lemmon_23 as a term

theorem lemmon_23' {p : Prop} (h : p → ¬ p) : ¬ p :=
λ hp : p, (h hp) hp

#check @lemmon_23' p
#check lemmon_23'

theorem lemmon_44 {p : Prop} : p ∨ ¬ p :=
have hdn : ¬ ¬ (p ∨ ¬ p), from (
  assume h : ¬ (p ∨ ¬ p),
  have hnp : ¬ p, from (
    assume hp : p,
    have h1 : p ∨ ¬ p, from or.intro_left (¬ p) hp,
    show false, from h h1),
  have h2 : p ∨ ¬ p, from or.intro_right p hnp,
  show false, from h h2),
show p ∨ ¬ p, from dne hdn

-- Not sure about the "assume", "show" syntax,
-- but it looks like lambda abstraction.
-- Does "show" pair up with the nearest "assume" and close its scope?
-- I think "show" simply annotates the result given by the "from".

-- "show" and "from" are used to annotate a term,
-- which could be expected in the context of either the definition or the lambda

#check @lemmon_44 p
#check lemmon_44
#print lemmon_44

-- Try using "suffices" to improve lemmon_44

theorem lemmon_44' {p : Prop} : p ∨ ¬ p :=
suffices hdn : ¬ ¬ (p ∨ ¬ p), from dne hdn,
assume h : ¬ (p ∨ ¬ p),
have hnp : ¬ p, from (
  assume hp : p,
  have h1 : p ∨ ¬ p, from or.intro_left (¬ p) hp,
  show false, from h h1),
have h2 : p ∨ ¬ p, from or.intro_right p hnp,
show false, from h h2

#check lemmon_44'

example (h : ¬ ¬ p) : p :=
by_cases
  (assume h1 : p, h1)
  (assume h1 : ¬ p, absurd h1 h)

example (h : ¬ ¬ p) : p :=
by_contradiction
  (assume h1 : ¬ p,
    show false, from h h1)

example (h : ¬ (p ∧ q)) : ¬ p ∨ ¬ q :=
or.elim (em p)
  (assume hp : p,
    or.inr
      (show ¬ q, from
        assume hq : q,
        h ⟨ hp, hq ⟩ ))
  (assume hp : ¬ p,
    or.inl hp)


/-
  Package the definition of an open cover of an open set.
-/

import topology.basic
import topology.opens
import to_mathlib.opens

universes u

open topological_space lattice

section covering

variables {α : Type u} [topological_space α]

-- Open cover.

structure covering (U : opens α) :=
{γ    : Type u}
(Uis  : γ → opens α)
(Hcov : ⋃ Uis = U)

variable (α)

def covering.univ := covering (@opens.univ α _)

variable {α}

-- If ⋃ Ui = U then for all i, Ui ⊆ U.

lemma subset_covering {U : opens α} {OC : covering U} :
∀ i, OC.Uis i ⊆ U :=
λ i x Hx, OC.Hcov ▸ opens_supr_mem OC.Uis i x Hx

-- Make covering from standard definition. Used for instance in compactness.

def opens.from_sets {A : Type*} [topological_space A]
: set (set A) → set (opens A) := λ C, { x | x.1 ∈ C }

lemma opens.from_sets.eq {A : Type*} [topological_space A]
(S : set (set A)) (HS : ∀ (t : set A), t ∈ S → is_open t)
: subtype.val '' (opens.from_sets S) = S :=
set.ext $ λ x, ⟨
  λ ⟨x', Hx', Hval⟩, Hval ▸ Hx',
  λ Hx, by simp [HS x Hx]; by exact Hx⟩

@[reducible] def covering.from_cover {A : Type*} [topological_space A]
(U     : opens A)
(C     : set (set A))
(HC    : ∀ (t : set A), t ∈ C → is_open t)
(Hcov : U.1 = ⋃₀ C)
: covering U :=
{ γ := opens.from_sets C,
  Uis := λ x, x,
  Hcov :=
    begin
      apply subtype.ext.2,
      rw Hcov,
      apply set.ext,
      intros x,
      split,
      { intros Hx,
        rcases Hx with ⟨U, HU, HxU⟩,
        existsi U,
        simp at HU,
        rcases HU with ⟨OU, HU⟩,
        rw ←opens.from_sets.eq C HC,
        split,
        { simp [HU],
          use OU, },
        { exact HxU, } },
      { intros Hx,
        rcases Hx with ⟨U, HU, HxU⟩,
        use U,
        simp,
        use (HC U HU),
        { simp [opens.from_sets],
          exact HU, },
        { exact HxU, }  }
    end, }

lemma covering.from_cover.Uis {A : Type*} [topological_space A]
(U     : opens A)
(C     : set (set A))
(HC    : ∀ (t : set A), t ∈ C → is_open t)
(Hcov : U.1 = ⋃₀ C)
: ∀ i, ((covering.from_cover U C HC Hcov).Uis i).1 ∈ C :=
begin
  intros i,
  simp [covering.from_cover] at *,
  cases i with i Hi,
  simp,
  simp [opens.from_sets] at *,
  exact Hi,
end

end covering


/-
Copyright (c) 2020 Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bhavik Mehta
-/

import combinatorics.composition
import data.nat.parity
import tactic.apply_fun

/-!
# Partitions

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

A partition of a natural number `n` is a way of writing `n` as a sum of positive integers, where the
order does not matter: two sums that differ only in the order of their summands are considered the
same partition. This notion is closely related to that of a composition of `n`, but in a composition
of `n` the order does matter.
A summand of the partition is called a part.

## Main functions

* `p : partition n` is a structure, made of a multiset of integers which are all positive and
  add up to `n`.

## Implementation details

The main motivation for this structure and its API is to show Euler's partition theorem, and
related results.

The representation of a partition as a multiset is very handy as multisets are very flexible and
already have a well-developed API.

## Tags

Partition

## References

<https://en.wikipedia.org/wiki/Partition_(number_theory)>
-/

variables {α : Type*}

open multiset
open_locale big_operators

namespace nat

/-- A partition of `n` is a multiset of positive integers summing to `n`. -/
@[ext, derive decidable_eq] structure partition (n : ℕ) :=
(parts : multiset ℕ)
(parts_pos : ∀ {i}, i ∈ parts → 0 < i)
(parts_sum : parts.sum = n)

namespace partition

/-- A composition induces a partition (just convert the list to a multiset). -/
def of_composition (n : ℕ) (c : composition n) : partition n :=
{ parts := c.blocks,
  parts_pos := λ i hi, c.blocks_pos hi,
  parts_sum := by rw [multiset.coe_sum, c.blocks_sum] }

lemma of_composition_surj {n : ℕ} : function.surjective (of_composition n) :=
begin
  rintro ⟨b, hb₁, hb₂⟩,
  rcases quotient.exists_rep b with ⟨b, rfl⟩,
  refine ⟨⟨b, λ i hi, hb₁ hi, _⟩, partition.ext _ _ rfl⟩,
  simpa using hb₂
end

/--
Given a multiset which sums to `n`, construct a partition of `n` with the same multiset, but
without the zeros.
-/
-- The argument `n` is kept explicit here since it is useful in tactic mode proofs to generate the
-- proof obligation `l.sum = n`.
def of_sums (n : ℕ) (l : multiset ℕ) (hl : l.sum = n) : partition n :=
{ parts := l.filter (≠ 0),
  parts_pos := λ i hi, nat.pos_of_ne_zero $ by apply of_mem_filter hi,
  parts_sum :=
  begin
    have lt : l.filter (= 0) + l.filter (≠ 0) = l := filter_add_not _ l,
    apply_fun multiset.sum at lt,
    have lz : (l.filter (= 0)).sum = 0,
    { rw multiset.sum_eq_zero_iff,
      simp },
    simpa [lz, hl] using lt,
  end }

/-- A `multiset ℕ` induces a partition on its sum. -/
def of_multiset (l : multiset ℕ) : partition l.sum :=
of_sums _ l rfl

/-- The partition of exactly one part. -/
def indiscrete_partition (n : ℕ) : partition n :=
of_sums n {n} rfl

instance {n : ℕ} : inhabited (partition n) := ⟨indiscrete_partition n⟩

/--
The number of times a positive integer `i` appears in the partition `of_sums n l hl` is the same
as the number of times it appears in the multiset `l`.
(For `i = 0`, `partition.non_zero` combined with `multiset.count_eq_zero_of_not_mem` gives that
this is `0` instead.)
-/
lemma count_of_sums_of_ne_zero {n : ℕ} {l : multiset ℕ} (hl : l.sum = n) {i : ℕ} (hi : i ≠ 0) :
  (of_sums n l hl).parts.count i = l.count i :=
count_filter_of_pos hi

lemma count_of_sums_zero {n : ℕ} {l : multiset ℕ} (hl : l.sum = n) :
  (of_sums n l hl).parts.count 0 = 0 :=
count_filter_of_neg (λ h, h rfl)

/--
Show there are finitely many partitions by considering the surjection from compositions to
partitions.
-/
instance (n : ℕ) : fintype (partition n) :=
fintype.of_surjective (of_composition n) of_composition_surj

/-- The finset of those partitions in which every part is odd. -/
def odds (n : ℕ) : finset (partition n) :=
finset.univ.filter (λ c, ∀ i ∈ c.parts, ¬ even i)

/-- The finset of those partitions in which each part is used at most once. -/
def distincts (n : ℕ) : finset (partition n) :=
finset.univ.filter (λ c, c.parts.nodup)

/-- The finset of those partitions in which every part is odd and used at most once. -/
def odd_distincts (n : ℕ) : finset (partition n) := odds n ∩ distincts n

end partition
end nat


/-
-/

section homework

variables P Q R S : Prop

example : (P → (Q → R)) → (P ∧ Q → R) :=
    sorry

example : P ∧ (P → Q) → Q :=
assume h : P ∧ (P → Q),
have p : P := h.left,
show Q,
from h.right p

example : P → ¬ (¬ P ∧ Q) :=
assume p: P,
assume c: (¬ P ∧ Q),
have np: ¬ P := c.left,
show false,
from np p

example : ¬ (P ∧ Q) → (P → ¬ Q) :=
assume h : ¬ (P ∧ Q),
assume p : P,
sorry

example (h₁ : P ∨ Q) (h₂ : P → R) (h₃ : Q → S) : R ∨ S :=
sorry

example (h : ¬ P ∧ ¬ Q) : ¬ (P ∨ Q) :=
sorry

example : ¬ (P ↔ ¬ P) :=
sorry

/-
Prove P → ¬ ¬ P without using
the axiom of the excluded middle.

Can you prove ¬ ¬ P → P without using
the axiom of the excluded middle. Explain.

Can you prove (P → Q) → (¬ Q → ¬ P)
"intuitionistically" (without relying
directly or indirectly on the axiom
of the excluded middle)? If so, prove
it intuitionistically. If not, explain
exactly where you get stuck and then
prove it "classically" (where you can
use, directly or indirectly, the axiom
of the excluded middle).

Can you prove (¬ Q → ¬ P) → (P → Q)
"intuitionistically" (without relying
directly or indirectly on the axiom
of the excluded middle)? If so, prove
it intuitionistically. If not, explain
exactly where you get stuck and then
prove it "classically" (where you can
use, directly or indirectly, the axiom
of the excluded middle).
-/

Commutativity of ∧: A∧B↔B∧A
Commutativity of ∨: A∨B↔B∨A
Associativity of ∧: (A∧B)∧C↔A∧(B∧C)
Associativity of ∨ (A∨B)∨C↔A∨(B∨C)
Distributivity of ∧ over ∨: A∧(B∨C)↔(A∧B)∨(A∧C)
Distributivity of ∨ over ∧: A∨(B∧C)↔(A∨B)∧(A∨C)
(A→(B→C))↔(A∧B→C).
(A→B)→((B→C)→(A→C))
((A∨B)→C)↔(A→C)∧(B→C)
¬(A∨B)↔¬A∧¬B
¬(A∧B)↔¬A∨¬B
¬(A∧¬A)
¬(A→B)↔A∧¬B
¬A→(A→B)
(¬A∨B)↔(A→B)
A∨⊥↔A
A∧⊥↔⊥
A∨¬A
¬(A↔¬A)
(A→B)↔(¬B→¬A)
(A→C∨D)→((A→C)∨(A→D))
(((A→B)→A)→A)

Give a natural deduction proof of ¬(A∧B)→(A→¬B).
Give a natural deduction proof of (A→C)∧(B→¬C)→¬(A∧B).
Give a natural deduction proof of (A∧B)→((A→C)→¬(B→¬C)).
Take another look at Exercise 3 in the last chapter. Using propositional variables A, B, and C for “Alan likes kangaroos,” “Betty likes frogs” and “Carl likes hamsters,” respectively, express the three hypotheses in the previous problem as symbolic formulas, and then derive a contradiction from them in natural deduction.
Give a natural deduction proof of A∨B→B∨A.
Give a natural deduction proof of ¬A∧¬B→¬(A∨B)
Give a natural deduction proof of ¬(A∧B) from ¬A∨¬B. (You do not need to use proof by contradiction.)
Give a natural deduction proof of ¬(A↔¬A).
Give a natural deduction proof of (¬A↔¬B) from hypothesis A↔B.

end homework


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

Structures with multiplicative and additive components, including semirings, rings, and fields.
The development is modeled after Isabelle's library.
-/

import .group
universes u v w
hott_theory
set_option old_structure_cmd true

namespace hott
open algebra

variable {A : Type _}
namespace algebra
/- auxiliary classes -/

@[hott, class] structure distrib (A : Type _) extends has_mul A, has_add A :=
(left_distrib : Πa b c, mul a (add b c) = add (mul a b) (mul a c))
(right_distrib : Πa b c, mul (add a b) c = add (mul a c) (mul b c))

@[hott] def left_distrib [s : distrib A] (a b c : A) : a * (b + c) = a * b + a * c :=
distrib.left_distrib _ _ _

@[hott] def right_distrib [s: distrib A] (a b c : A) : (a + b) * c = a * c + b * c :=
distrib.right_distrib _ _ _

@[hott, class] structure mul_zero_class (A : Type _) extends has_mul A, has_zero A :=
(zero_mul : Πa, mul zero a = zero)
(mul_zero : Πa, mul a zero = zero)

@[hott] def zero_mul [s : mul_zero_class A] (a : A) : 0 * a = 0 := mul_zero_class.zero_mul _
@[hott] def mul_zero [s : mul_zero_class A] (a : A) : a * 0 = 0 := mul_zero_class.mul_zero _

@[hott, class] structure zero_ne_one_class (A : Type _) extends has_zero A, has_one A :=
(zero_ne_one : zero ≠ one)

@[hott] theorem zero_ne_one [s: zero_ne_one_class A] : 0 ≠ (1:A) := @zero_ne_one_class.zero_ne_one A s

/- semiring -/
@[hott] structure semiring (A : Type _) extends comm_monoid A renaming
  mul→add mul_assoc→add_assoc one→zero one_mul→zero_add mul_one→add_zero mul_comm→add_comm,
  monoid A, distrib A, mul_zero_class A

/- we make it a class now (and not as part of the structure) to avoid
  semiring.to_comm_monoid to be an instance -/
attribute [class] semiring

@[hott, reducible, instance] def add_comm_monoid_of_semiring (A : Type _)
  [H : semiring A] : add_comm_monoid A :=
@semiring.to_comm_monoid A H

@[hott, reducible, instance] def monoid_of_semiring (A : Type _)
  [H : semiring A] : monoid A :=
@semiring.to_monoid A H

@[hott, reducible, instance] def distrib_of_semiring (A : Type _)
  [H : semiring A] : distrib A :=
@semiring.to_distrib A H

@[hott, reducible, instance] def mul_zero_class_of_semiring (A : Type _)
  [H : semiring A] : mul_zero_class A :=
@semiring.to_mul_zero_class A H

section semiring
  variables [s : semiring A] (a b c : A)
  include s

  @[hott] theorem As {a b c : A} : a + b + c = a + (b + c) :=
  add.assoc _ _ _

  @[hott] theorem one_add_one_eq_two : 1 + 1 = 2 :> A :=
  by refl

  @[hott] theorem ne_zero_of_mul_ne_zero_right {a b : A} (H : a * b ≠ 0) : a ≠ 0 :=
  λthis,
  have a * b = 0, by rwr [this, zero_mul],
  H this

  @[hott] theorem ne_zero_of_mul_ne_zero_left {a b : A} (H : a * b ≠ 0) : b ≠ 0 :=
  λthis,
  have a * b = 0, by rwr [this, mul_zero],
  H this

  @[hott] theorem distrib_three_right (a b c d : A) : (a + b + c) * d = a * d + b * d + c * d :=
  by rwr [right_distrib, right_distrib]

  @[hott] theorem mul_two : a * 2 = a + a :=
  by rwr [←one_add_one_eq_two, left_distrib, mul_one]

  @[hott] theorem two_mul : 2 * a = a + a :=
  by rwr [←one_add_one_eq_two, right_distrib, one_mul]

end semiring

/- comm semiring -/

@[hott, class] structure comm_semiring (A : Type _) extends semiring A, comm_monoid A
-- TODO: we could also define a cancelative comm_semiring, i.e. satisfying
-- c ≠ 0 → c * a = c * b → a = b.

-- section comm_semiring
--   variables [s : comm_semiring A] (a b c : A)
--   include s

--   @[hott] protected def algebra.dvd (a b : A) : Type _ := Σc, b = a * c

--   @[hott, instance, priority 500] def comm_semiring_has_dvd : has_dvd A :=
--   has_dvd.mk hott.algebra.dvd

--   @[hott] theorem dvd.intro {a b c : A} (H : a * c = b) : a ∣ b :=
--   sigma.mk _ H⁻¹

--   @[hott] theorem dvd_of_mul_right_eq {a b c : A} (H : a * c = b) : a ∣ b := dvd.intro H

--   @[hott] theorem dvd.intro_left {a b c : A} (H : c * a = b) : a ∣ b :=
--   by rwr mul.comm at H; exact dvd.intro H

--   @[hott] theorem dvd_of_mul_left_eq {a b c : A} (H : c * a = b) : a ∣ b := dvd.intro_left H

--   @[hott] theorem exists_eq_mul_right_of_dvd {a b : A} (H : a ∣ b) : Σc, b = a * c := H

--   @[hott] theorem dvd.elim {P : Type _} {a b : A} (H₁ : a ∣ b) (H₂ : Πc, b = a * c → P) : P :=
--   sigma.rec_on H₁ H₂

--   @[hott] theorem exists_eq_mul_left_of_dvd {a b : A} (H : a ∣ b) : Σc, b = c * a :=
--   dvd.elim H (take c, assume H1 : b = a * c, sigma.mk c (H1 ⬝ mul.comm _ _))

--   @[hott] theorem dvd.elim_left {P : Type _} {a b : A} (H₁ : a ∣ b) (H₂ : Πc, b = c * a → P) : P :=
--   sigma.rec_on (exists_eq_mul_left_of_dvd H₁) (take c, assume H₃ : b = c * a, H₂ c H₃)

--   @[hott] theorem dvd.refl : a ∣ a := dvd.intro (mul_one _)

--   @[hott] theorem dvd.trans {a b c : A} (H₁ : a ∣ b) (H₂ : b ∣ c) : a ∣ c :=
--   dvd.elim H₁
--     (take d, assume H₃ : b = a * d,
--       dvd.elim H₂
--         (take e, assume H₄ : c = b * e,
--           dvd.intro
--             (show a * (d * e) = c, by rwr [←mul.assoc, -H₃, H₄])))

--   @[hott] theorem eq_zero_of_zero_dvd {a : A} (H : 0 ∣ a) : a = 0 :=
--     dvd.elim H (take c, assume H' : a = 0 * c, H' ⬝ (zero_mul _))

--   @[hott] theorem dvd_zero : a ∣ 0 := dvd.intro (mul_zero _)

--   @[hott] theorem one_dvd : 1 ∣ a := dvd.intro (one_mul _)

--   @[hott] theorem dvd_mul_right : a ∣ a * b := dvd.intro rfl

--   @[hott] theorem dvd_mul_left : a ∣ b * a :=
--   by rwr mul.comm; apply dvd_mul_right

--   @[hott] theorem dvd_mul_of_dvd_left {a b : A} (H : a ∣ b) (c : A) : a ∣ b * c :=
--   dvd.elim H
--     (take d,
--       suppose b = a * d,
--       dvd.intro
--         (show a * (d * c) = b * c, from by rwr [←mul.assoc]; substvars))

--   @[hott] theorem dvd_mul_of_dvd_right {a b : A} (H : a ∣ b) (c : A) : a ∣ c * b :=
--   by rwr mul.comm; exact dvd_mul_of_dvd_left H _

--   @[hott] theorem mul_dvd_mul {a b c d : A} (dvd_ab : a ∣ b) (dvd_cd : c ∣ d) : a * c ∣ b * d :=
--   dvd.elim dvd_ab
--     (take e, suppose b = a * e,
--       dvd.elim dvd_cd
--         (take f, suppose d = c * f,
--           dvd.intro
--             (show a * c * (e * f) = b * d,
--              by rwr [mul.assoc, {c*_}mul.left_comm, -mul.assoc]; substvars)))

--   @[hott] theorem dvd_of_mul_right_dvd {a b c : A} (H : a * b ∣ c) : a ∣ c :=
--   dvd.elim H (take d, assume Habdc : c = a * b * d, dvd.intro ((mul.assoc _ _ _)⁻¹ ⬝ (Habdc _ _ _ _)⁻¹))

--   @[hott] theorem dvd_of_mul_left_dvd {a b c : A} (H : a * b ∣ c) : b ∣ c :=
--   by apply dvd_of_mul_right_dvd; rwr mul.comm; exact H

--   @[hott] theorem dvd_add {a b c : A} (Hab : a ∣ b) (Hac : a ∣ c) : a ∣ b + c :=
--   dvd.elim Hab
--     (take d, suppose b = a * d,
--       dvd.elim Hac
--         (take e, suppose c = a * e,
--           dvd.intro (show a * (d + e) = b + c,
--                      by rwr [left_distrib]; substvars)))
-- end comm_semiring

/- ring -/

@[hott] structure ring (A : Type _) extends ab_group A renaming mul→add mul_assoc→add_assoc
  one→zero one_mul→zero_add mul_one→add_zero inv→neg mul_left_inv→add_left_inv mul_comm→add_comm,
  monoid A, distrib A

/- we make it a class now (and not as part of the structure) to avoid
  ring.to_ab_group to be an instance -/
attribute [class] ring

@[hott, reducible, instance] def add_ab_group_of_ring (A : Type _)
  [H : ring A] : add_ab_group A :=
@ring.to_ab_group A H

@[hott, reducible, instance] def monoid_of_ring (A : Type _)
  [H : ring A] : monoid A :=
@ring.to_monoid A H

@[hott, reducible, instance] def distrib_of_ring (A : Type _)
  [H : ring A] : distrib A :=
@ring.to_distrib A H

@[hott] def ring.mul_zero [s : ring A] (a : A) : a * 0 = 0 :=
have a * 0 + 0 = a * 0 + a * 0, from calc
  a * 0 + 0 = a * 0         : by rwr add_zero
        ... = a * (0 + 0)   : by rwr add_zero
        ... = a * 0 + a * 0 : left_distrib a 0 0,
show a * 0 = 0, from (add.left_cancel this)⁻¹

@[hott] def ring.zero_mul [s : ring A] (a : A) : 0 * a = 0 :=
have 0 * a + 0 = 0 * a + 0 * a, from calc
  0 * a + 0 = 0 * a         : by rwr add_zero
        ... = (0 + 0) * a   : by rwr add_zero
        ... = 0 * a + 0 * a : right_distrib 0 0 a,
show 0 * a = 0, from  (add.left_cancel this)⁻¹

@[hott, reducible, instance] def ring.to_semiring [s : ring A] : semiring A :=
{ mul_zero := ring.mul_zero,
  zero_mul := ring.zero_mul, ..s}

section
variables [s : ring A] (a b c d e : A)
include s

@[hott] def neg_mul_eq_neg_mul : -(a * b) = -a * b :=
neg_eq_of_add_eq_zero
  begin
    rwr [←right_distrib, add.right_inv, zero_mul]
  end

@[hott] def neg_mul_eq_mul_neg : -(a * b) = a * -b :=
 neg_eq_of_add_eq_zero
   begin
     rwr [←left_distrib, add.right_inv, mul_zero]
   end

@[hott] def neg_mul_eq_neg_mul_symm : - a * b = - (a * b) := (neg_mul_eq_neg_mul _ _)⁻¹ᵖ
@[hott] def mul_neg_eq_neg_mul_symm : a * - b = - (a * b) := (neg_mul_eq_mul_neg _ _)⁻¹ᵖ

@[hott] theorem neg_mul_neg : -a * -b = a * b :=
calc
   -a * -b = -(a * -b) : by rwr ←neg_mul_eq_neg_mul
     ... = - -(a * b)  : by rwr ←neg_mul_eq_mul_neg
     ... = a * b       : by rwr neg_neg

@[hott] theorem neg_mul_comm : -a * b = a * -b :=
(neg_mul_eq_neg_mul _ _)⁻¹ ⬝ (neg_mul_eq_mul_neg _ _)

@[hott] def neg_eq_neg_one_mul : -a = - 1 * a :=
calc
  -a = -(1 * a)  : by rwr one_mul
    ... = - 1 * a : by rwr neg_mul_eq_neg_mul

@[hott] def mul_sub_left_distrib : a * (b - c) = a * b - a * c :=
calc
  a * (b - c) = a * b + a * -c : left_distrib _ _ _
    ... = a * b + - (a * c)    : by rwr ←neg_mul_eq_mul_neg
    ... = a * b - a * c        : rfl

@[hott] def mul_sub_right_distrib : (a - b) * c = a * c - b * c :=
calc
  (a - b) * c = a * c  + -b * c : right_distrib _ _ _
    ... = a * c + - (b * c)     : by rwr neg_mul_eq_neg_mul
    ... = a * c - b * c         : rfl

@[hott] theorem mul_add_eq_mul_add_iff_sub_mul_add_eq :
  a * e + c = b * e + d ↔ (a - b) * e + c = d :=
calc
  a * e + c = b * e + d ↔ a * e + c = d + b * e : by rwr add.comm (b*e)
    ... ↔ a * e + c - b * e = d : iff.symm (sub_eq_iff_eq_add _ _ _)
    ... ↔ a * e - b * e + c = d : by rwr sub_add_eq_add_sub
    ... ↔ (a - b) * e + c = d   : by rwr mul_sub_right_distrib

@[hott] theorem mul_add_eq_mul_add_of_sub_mul_add_eq :
  (a - b) * e + c = d → a * e + c = b * e + d :=
iff.mpr (mul_add_eq_mul_add_iff_sub_mul_add_eq _ _ _ _ _)

@[hott] theorem sub_mul_add_eq_of_mul_add_eq_mul_add :
  a * e + c = b * e + d → (a - b) * e + c = d :=
iff.mp (mul_add_eq_mul_add_iff_sub_mul_add_eq _ _ _ _ _)

@[hott] theorem mul_neg_one_eq_neg : a * (- 1) = -a :=
  have a + a * - 1 = 0, from calc
    a + a * - 1 = a * 1 + a * - 1 : by rwr mul_one
           ... = a * (1 + - 1)   : by rwr left_distrib
           ... = a * 0          : by rwr add.right_inv
           ... = 0              : by rwr mul_zero,
  (neg_eq_of_add_eq_zero this)⁻¹

@[hott] theorem ne_zero_prod_ne_zero_of_mul_ne_zero {a b : A} (H : a * b ≠ 0) : a ≠ 0 × b ≠ 0 :=
  have H1 : a ≠ 0, from
    (λthis,
      have a * b = 0, by rwr [this, zero_mul],
      absurd this H),
  have b ≠ 0, from
    (λthis,
      have a * b = 0, by rwr [this, mul_zero],
      absurd this H),
  prod.mk H1 this
end

@[hott, class] structure comm_ring (A : Type _) extends ring A, comm_semigroup A

@[hott, reducible, instance] def comm_ring.to_comm_semiring [s : comm_ring A] :
  comm_semiring A :=
{ mul_zero := mul_zero,
  zero_mul := zero_mul, ..s }

section
  variables [s : comm_ring A] (a b c d e : A)
  include s

  @[hott] theorem mul_self_sub_mul_self_eq : a * a - b * b = (a + b) * (a - b) :=
  begin
    change a * a + - (b * b) = (a + b) * (a + - b),
    rwr [left_distrib, right_distrib, right_distrib, add.assoc],
    rwr [←add.assoc (b*a),
             ←neg_mul_eq_mul_neg, ←neg_mul_eq_mul_neg, mul.comm a b, add.right_inv, zero_add]
  end

  @[hott] theorem mul_self_sub_one_eq : a * a - 1 = (a + 1) * (a - 1) :=
  by rwr [←mul_self_sub_mul_self_eq, mul_one]

  -- @[hott] theorem dvd_neg_iff_dvd : (a ∣ -b) ↔ (a ∣ b) :=
  -- iff.intro
  --   (suppose a ∣ -b,
  --     dvd.elim this
  --       (take c, suppose -b = a * c,
  --         dvd.intro
  --           (show a * -c = b,
  --            by rwr [←neg_mul_eq_mul_neg, -this, neg_neg])))
  --   (suppose a ∣ b,
  --     dvd.elim this
  --       (take c, suppose b = a * c,
  --         dvd.intro
  --           (show a * -c = -b,
  --            by rwr [←neg_mul_eq_mul_neg, -this])))

  -- @[hott] theorem dvd_neg_of_dvd : (a ∣ b) → (a ∣ -b) :=
  --   iff.mpr (dvd_neg_iff_dvd _ _)

  -- @[hott] theorem dvd_of_dvd_neg : (a ∣ -b) → (a ∣ b) :=
  --   iff.mp (dvd_neg_iff_dvd _ _)

  -- @[hott] theorem neg_dvd_iff_dvd : (-a ∣ b) ↔ (a ∣ b) :=
  -- iff.intro
  --   (suppose -a ∣ b,
  --     dvd.elim this
  --       (take c, suppose b = -a * c,
  --         dvd.intro
  --           (show a * -c = b, by rwr [←neg_mul_comm, this])))
  --   (suppose a ∣ b,
  --     dvd.elim this
  --       (take c, suppose b = a * c,
  --         dvd.intro
  --           (show -a * -c = b, by rwr [neg_mul_neg, this])))

  -- @[hott] theorem neg_dvd_of_dvd : (a ∣ b) → (-a ∣ b) :=
  --   iff.mpr (neg_dvd_iff_dvd _ _)

  -- @[hott] theorem dvd_of_neg_dvd : (-a ∣ b) → (a ∣ b) :=
  --   iff.mp (neg_dvd_iff_dvd _ _)

  -- @[hott] theorem dvd_sub (H₁ : (a ∣ b)) (H₂ : (a ∣ c)) : (a ∣ b - c) :=
  -- dvd_add H₁ (dvd_neg_of_dvd H₂)
end

/- integral domains -/

@[hott, class] structure no_zero_divisors (A : Type _) extends has_mul A, has_zero A :=
(eq_zero_sum_eq_zero_of_mul_eq_zero : Πa b, mul a b = zero → a = zero ⊎ b = zero)

@[hott] def eq_zero_sum_eq_zero_of_mul_eq_zero {A : Type _} [s : no_zero_divisors A] {a b : A}
    (H : a * b = 0) : a = 0 ⊎ b = 0 :=
no_zero_divisors.eq_zero_sum_eq_zero_of_mul_eq_zero _ _ H

@[hott, class] structure integral_domain (A : Type _) extends comm_ring A, no_zero_divisors A,
    zero_ne_one_class A

section
  variables [s : integral_domain A] (a b c d e : A)
  include s

  @[hott] theorem mul_ne_zero {a b : A} (H1 : a ≠ 0) (H2 : b ≠ 0) : a * b ≠ 0 :=
  λthis,
    sum.elim (eq_zero_sum_eq_zero_of_mul_eq_zero this) (assume H3, H1 H3) (assume H4, H2 H4)

  -- @[hott] theorem eq_of_mul_eq_mul_right {a b c : A} (Ha : a ≠ 0) (H : b * a = c * a) : b = c :=
  -- have b * a - c * a = 0, from iff.mp (eq_iff_sub_eq_zero _ _) H,
  -- have (b - c) * a = 0, by rwr [mul_sub_right_distrib, this],
  -- have b - c = 0, from sum_resolve_left (eq_zero_sum_eq_zero_of_mul_eq_zero this) Ha,
  -- iff.elim_right (eq_iff_sub_eq_zero _ _) this

  -- @[hott] theorem eq_of_mul_eq_mul_left {a b c : A} (Ha : a ≠ 0) (H : a * b = a * c) : b = c :=
  -- have a * b - a * c = 0, from iff.mp (eq_iff_sub_eq_zero _ _) H,
  -- have a * (b - c) = 0, by rwr [mul_sub_left_distrib, this],
  -- have b - c = 0, from sum_resolve_right (eq_zero_sum_eq_zero_of_mul_eq_zero this) Ha,
  -- iff.elim_right (eq_iff_sub_eq_zero _ _) this

  -- -- TODO: do we want the iff versions?

  -- @[hott] theorem eq_zero_of_mul_eq_self_right {a b : A} (H₁ : b ≠ 1) (H₂ : a * b = a) : a = 0 :=
  -- have b - 1 ≠ 0, by intro this; apply H₁; rwr zero_add; apply eq_add_of_sub_eq; exact this,
  -- have a * b - a = 0, by rwr H₂; apply sub_self,
  -- have a * (b - 1) = 0, by rwr [mul_sub_left_distrib, mul_one]; apply this,
  --   show a = 0, from sum_resolve_left (eq_zero_sum_eq_zero_of_mul_eq_zero this) `b - 1 ≠ 0`

  -- @[hott] theorem eq_zero_of_mul_eq_self_left {a b : A} (H₁ : b ≠ 1) (H₂ : b * a = a) : a = 0 :=
  -- by apply eq_zero_of_mul_eq_self_right H₁; by rwr mul.comm; exact H₂

  -- @[hott] theorem mul_self_eq_mul_self_iff (a b : A) : a * a = b * b ↔ a = b ⊎ a = -b :=
  -- iff.intro
  --   (suppose a * a = b * b,
  --     have (a - b) * (a + b) = 0,
  --       by rwr [mul.comm, -mul_self_sub_mul_self_eq, this, sub_self],
  --     have a - b = 0 ⊎ a + b = 0, from eq_zero_sum_eq_zero_of_mul_eq_zero this,
  --     sum.elim this
  --       (suppose a - b = 0, sum.inl (eq_of_sub_eq_zero this))
  --       (suppose a + b = 0, sum.inr (eq_neg_of_add_eq_zero this)))
  --   (suppose a = b ⊎ a = -b, sum.elim this
  --     (suppose a = b,  by rwr this)
  --     (suppose a = -b, by rwr [this, neg_mul_neg]))

  -- @[hott] theorem mul_self_eq_one_iff (a : A) : a * a = 1 ↔ a = 1 ⊎ a = - 1 :=
  -- have a * a = 1 * 1 ↔ a = 1 ⊎ a = - 1, from mul_self_eq_mul_self_iff a 1,
  -- by rwr mul_one at this; exact this

  -- -- TODO: c - b * c → c = 0 ⊎ b = 1 and variants

  -- @[hott] theorem dvd_of_mul_dvd_mul_left {a b c : A} (Ha : a ≠ 0) (Hdvd : (a * b ∣ a * c)) : (b ∣ c) :=
  -- dvd.elim Hdvd
  --   (take d,
  --     suppose a * c = a * b * d,
  --     have b * d = c, by apply eq_of_mul_eq_mul_left Ha; rwr [mul.assoc, this],
  --     dvd.intro this)

  -- @[hott] theorem dvd_of_mul_dvd_mul_right {a b c : A} (Ha : a ≠ 0) (Hdvd : (b * a ∣ c * a)) : (b ∣ c) :=
  -- dvd.elim Hdvd
  --   (take d,
  --     suppose c * a = b * a * d,
  --     have b * d * a = c * a, from by rwr [mul.right_comm, -this],
  --     have b * d = c, from eq_of_mul_eq_mul_right Ha this,
  --     dvd.intro this)
end

namespace norm_num

-- @[hott] theorem mul_zero [s : mul_zero_class A] (a : A) : a * zero = zero :=
--   by rwr [↑zero, mul_zero]

-- @[hott] theorem zero_mul [s : mul_zero_class A] (a : A) : zero * a = zero :=
--   by rwr [↑zero, zero_mul]

-- @[hott] theorem mul_one [s : monoid A] (a : A) : a * one = a :=
--   by rwr [↑one, mul_one]

-- @[hott] theorem mul_bit0 [s : distrib A] (a b : A) : a * (bit0 b) = bit0 (a * b) :=
--   by rwr [↑bit0, left_distrib]

-- @[hott] theorem mul_bit0_helper [s : distrib A] (a b t : A) (H : a * b = t) : a * (bit0 b) = bit0 t :=
--   by rwr ←H; apply mul_bit0

-- @[hott] theorem mul_bit1 [s : semiring A] (a b : A) : a * (bit1 b) = bit0 (a * b) + a :=
--   by rwr [↑bit1, ↑bit0, +left_distrib, ↑one, mul_one]

-- @[hott] theorem mul_bit1_helper [s : semiring A] (a b s t : A) (Hs : a * b = s) (Ht : bit0 s + a  = t) :
--         a * (bit1 b) = t :=
--   begin rwr [←Ht, -Hs, mul_bit1] end

-- @[hott] theorem subst_into_prod [s : has_mul A] (l r tl tr t : A) (prl : l = tl) (prr : r = tr)
--         (prt : tl * tr = t) :
--         l * r = t :=
--    by rwr [prl, prr, prt]

-- @[hott] theorem mk_cong (op : A → A) (a b : A) (H : a = b) : op a = op b :=
--   by congruence; exact H

-- @[hott] theorem mk_eq (a : A) : a = a := rfl

-- @[hott] theorem neg_add_neg_eq_of_add_add_eq_zero [s : add_ab_group A] (a b c : A) (H : c + a + b = 0) :
--         -a + -b = c :=
--   begin
--     apply add_neg_eq_of_eq_add,
--     apply neg_eq_of_add_eq_zero,
--     rwr [add.comm, add.assoc, add.comm b, -add.assoc, H]
--   end

-- @[hott] theorem neg_add_neg_helper [s : add_ab_group A] (a b c : A) (H : a + b = c) : -a + -b = -c :=
--   begin apply iff.mp (neg_eq_neg_iff_eq _ _), rwr [neg_add, *neg_neg, H] end

-- @[hott] theorem neg_add_pos_eq_of_eq_add [s : add_ab_group A] (a b c : A) (H : b = c + a) : -a + b = c :=
--   begin apply neg_add_eq_of_eq_add, rwr add.comm, exact H end

-- @[hott] theorem neg_add_pos_helper1 [s : add_ab_group A] (a b c : A) (H : b + c = a) : -a + b = -c :=
--   begin apply neg_add_eq_of_eq_add, apply eq_add_neg_of_add_eq H end

-- @[hott] theorem neg_add_pos_helper2 [s : add_ab_group A] (a b c : A) (H : a + c = b) : -a + b = c :=
--   begin apply neg_add_eq_of_eq_add, rwr H end

-- @[hott] theorem pos_add_neg_helper [s : add_ab_group A] (a b c : A) (H : b + a = c) : a + b = c :=
--   by rwr [add.comm, H]

-- @[hott] theorem sub_eq_add_neg_helper [s : add_ab_group A] (t₁ t₂ e w₁ w₂: A) (H₁ : t₁ = w₁)
--         (H₂ : t₂ = w₂) (H : w₁ + -w₂ = e) : t₁ - t₂ = e :=
--   by rwr [sub_eq_add_neg, H₁, H₂, H]

-- @[hott] theorem pos_add_pos_helper [s : add_ab_group A] (a b c h₁ h₂ : A) (H₁ : a = h₁) (H₂ : b = h₂)
--         (H : h₁ + h₂ = c) : a + b = c :=
--   by rwr [H₁, H₂, H]

-- @[hott] theorem subst_into_subtr [s : add_group A] (l r t : A) (prt : l + -r = t) : l - r = t :=
--    by rwr [sub_eq_add_neg, prt]

-- @[hott] theorem neg_neg_helper [s : add_group A] (a b : A) (H : a = -b) : -a = b :=
--   by rwr [H, neg_neg]

-- @[hott] theorem neg_mul_neg_helper [s : ring A] (a b c : A) (H : a * b = c) : (-a) * (-b) = c :=
--   begin rwr [neg_mul_neg, H] end

-- @[hott] theorem neg_mul_pos_helper [s : ring A] (a b c : A) (H : a * b = c) : (-a) * b = -c :=
--   begin rwr [←neg_mul_eq_neg_mul, H] end

-- @[hott] theorem pos_mul_neg_helper [s : ring A] (a b c : A) (H : a * b = c) : a * (-b) = -c :=
--   begin rwr [←neg_mul_comm, -neg_mul_eq_neg_mul, H] end

end norm_num
end algebra
end hott


import data.real.basic

variables {x y : ℝ}

namespace my_abs

-- BEGIN
theorem lt_abs : x < abs y ↔ x < y ∨ x < -y :=
begin
  split; intro h,
  { cases lt_or_ge y 0 with y_neg y_nonneg,
    { rw abs_of_neg y_neg at h, right, exact h, },
    { rw abs_of_nonneg y_nonneg at h, left, exact h, }, },
  { cases h with x_lt_y x_lt_neg_y,
    linarith [le_abs_self y],
    linarith [neg_le_abs_self y], }
end

theorem abs_lt : abs x < y ↔ - y < x ∧ x < y :=
begin
  split; intro h,
  { split,
    linarith [neg_abs_le_self x],
    linarith [le_abs_self x], },
  { cases lt_or_ge x 0 with x_neg x_nonneg,
    { rw abs_of_neg x_neg, linarith only [h.1], },
    { rw abs_of_nonneg x_nonneg, exact h.2 }, },
end
-- END

end my_abs


-- Estructuras y clases
-- =====================================================================

------------------------------------------------------------------------
-- § Introducción                                                     --
------------------------------------------------------------------------

-- ---------------------------------------------------------------------
-- Ejercicio. Importar las teorías data.rat.basic, data.nat.parity y
-- tactic.basic.
-- ---------------------------------------------------------------------

import data.rat.basic
import data.nat.parity
import tactic.basic

-- ---------------------------------------------------------------------
-- Ejercicio. Abrir la teoría de los naturales.
-- ----------------------------------------------------------------------

open nat

-- ---------------------------------------------------------------------
-- Ejercicio. Permitir en esta teoría definiciones no computables.
-- ----------------------------------------------------------------------

noncomputable theory

-- ---------------------------------------------------------------------
-- Ejercicio. Permitir el uso de la lógica clásica.
-- ----------------------------------------------------------------------

open_locale classical

------------------------------------------------------------------------
-- § Estructuras y clases                                             --
------------------------------------------------------------------------

------------------------------------------------------------------------
-- §§ Declaración de estructuras                                      --
------------------------------------------------------------------------

-- ---------------------------------------------------------------------
-- Ejercicio. Definir la estructura even_natural_number con dos campos
-- + n que es un número natural
-- + even_n que es una demostración de que n es par.
-- ----------------------------------------------------------------------

structure even_natural_number : Type :=
  (n : ℕ)
  (even_n : even n)

-- ---------------------------------------------------------------------
-- Ejercicio. Ver la información de even_natural_number
-- ----------------------------------------------------------------------

#print even_natural_number

-- Comentario: Al colocar el curso sobre print se obtiene
--    structure even_natural_number : Type
--    fields:
--    even_natural_number.n : even_natural_number → ℕ
--    even_natural_number.even_n : ∀ (c : even_natural_number), c.n.even

-- ---------------------------------------------------------------------
-- Ejercicio. Definir la estructuras (is_even_cube_above_100 n) cuyos
-- campos son
-- + even con una demostración de que n es par
-- + is_cube con una demostración de que n es un cubo y
-- + gt_100 con una demostración de que n es mayor que 100.
-- ----------------------------------------------------------------------

structure is_even_cube_above_100 (n : ℕ) : Prop :=
  (even : even n)
  (is_cube : ∃ k, n = k^3)
  (gt_100 : n > 100)

-- ---------------------------------------------------------------------
-- Ejercicio. Ver la información de (is_even_cube_above_100).
-- ----------------------------------------------------------------------

#print is_even_cube_above_100

-- Comentario: Al colocar el cursor sobre print se obtiene
--    structure is_even_cube_above_100 : ℕ → Prop
--    fields:
--    is_even_cube_above_100.even :
---     ∀ {n : ℕ}, is_even_cube_above_100 n → n.even
--    is_even_cube_above_100.is_cube :
--      ∀ {n : ℕ}, is_even_cube_above_100 n → (∃ (k : ℕ), n = k ^ 3)
--    is_even_cube_above_100.gt_100 :
--      ∀ {n : ℕ}, is_even_cube_above_100 n → n > 100

-- ---------------------------------------------------------------------
-- Ejercicio. Definir las estructuras (bound f) cuyo argumento es una
-- función de ℕ en ℕ y sus campos son
-- + bound que es un número natural
-- + le_bound que es una prueba de que bound es una cota superior de f.
-- ----------------------------------------------------------------------

structure bounds (f : ℕ → ℕ) :=
  (bound : ℕ)
  (le_bound : ∀ (n : ℕ), f n ≤ bound)

-- ---------------------------------------------------------------------
-- Ejercicio. Ver la información de bounds
-- ----------------------------------------------------------------------

#print bounds

-- Comentario: Al colocar el cursor sobre print se obtiene
--    structure bounds : (ℕ → ℕ) → Type
--    fields:
--    bounds.bound : Π {f : ℕ → ℕ}, bounds f → ℕ
--    bounds.le_bound : ∀ {f : ℕ → ℕ} (c : bounds f) (n : ℕ), f n ≤ c.bound

-- ---------------------------------------------------------------------
-- Ejercicio. Definir la estructura eventually_constant_sequence cuyos
-- campos son
-- + seq que es una sucesión entera
-- + eventually_constant que afirma que seq es eventualmente constante.
-- ----------------------------------------------------------------------

structure eventually_constant_sequence : Type :=
(seq : ℕ → ℕ)
(eventually_constant : ∃ k v, ∀ n ≥ k, seq n = v)

-- ---------------------------------------------------------------------
-- Ejercicio. Definir la estructura bipointed_type de los tipos don dos
-- elementos distintos.
-- ----------------------------------------------------------------------

structure bipointed_type :=
(A : Type)
(x y : A)
(x_ne_y : x ≠ y)

------------------------------------------------------------------------
-- § Proyecciones de una estructura                                   --
------------------------------------------------------------------------

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que si
--    is_even_cube_above_100 n
-- entonces n es mayor que 100.
-- ----------------------------------------------------------------------

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

example
  (n : ℕ)
  (hn : is_even_cube_above_100 n)
  : n > 100 :=
is_even_cube_above_100.gt_100 hn

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

section

open is_even_cube_above_100

example
  (n : ℕ)
  (hn : is_even_cube_above_100 n)
  : n > 100 :=
gt_100 hn

end

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que si
--    is_even_cube_above_100 n
-- entonces n es par.
-- ----------------------------------------------------------------------

example
  (n : ℕ)
  (hn : is_even_cube_above_100 n)
  : even n :=
hn.even

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que si
--    is_even_cube_above_100 n
-- entonces n es par y cubo.
-- ----------------------------------------------------------------------

example
  (n : ℕ)
  (hn : is_even_cube_above_100 n)
  : even n ∧ ∃ k, n = k^3 :=
⟨ hn.even, hn.is_cube ⟩

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que si
--    is_even_cube_above_100 n
-- entonces n es par, mayor que 100 y cubo.
-- ----------------------------------------------------------------------

example
  (n : ℕ)
  (hn : is_even_cube_above_100 n)
  : even n ∧ n > 100 ∧ (∃ k, n = k^3) :=
⟨ hn.1, hn.3, hn.2 ⟩

-- ---------------------------------------------------------------------
-- Ejercicio. Definir la función
--    is_even_cube_above_100' : ℕ → Prop
-- tal que 8is_even_cube_above_100') afirma que n es par, cubo y mayor
-- que 100.
-- ----------------------------------------------------------------------

def is_even_cube_above_100' (n : ℕ) : Prop :=
even n ∧ (∃ k, n = k^3) ∧ n > 100

-- ---------------------------------------------------------------------
-- Ejercicio. Definir el subtipo even_natural_number' de los números
-- naturales pares.
-- ----------------------------------------------------------------------

def even_natural_number' : Type :=
{ n : ℕ // even n }

-- ---------------------------------------------------------------------
-- Ejercicio. Definir el conjunto set_of_even_natural_numbers de los
-- números naturales pares.
-- ----------------------------------------------------------------------

def set_of_even_natural_numbers : set ℕ :=
{ n : ℕ | even n }

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que
--    even_natural_number → even_natural_number'
-- ----------------------------------------------------------------------

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

example : even_natural_number → even_natural_number' :=
begin
  intro h,
  cases h with n hn,
  use n,
  exact hn,
end

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

example : even_natural_number → even_natural_number' :=
λ n, ⟨n.1, n.2⟩

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que, para todo natural n,
--    is_even_cube_above_100 n → is_even_cube_above_100' n
-- ----------------------------------------------------------------------

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

example
  (n : ℕ)
  : is_even_cube_above_100 n → is_even_cube_above_100' n :=
begin
  intro hn,
  cases hn with neven ncube ngt,
  split,
  { exact neven, },
  { split,
    { exact ncube, },
    { exact ngt, }},
end

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

example
  (n : ℕ)
  : is_even_cube_above_100 n → is_even_cube_above_100' n :=
begin
  rintros ⟨neven, ncube, ngt⟩,
  exact ⟨neven, ncube, ngt⟩,
end

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

example
  (n : ℕ)
  : is_even_cube_above_100 n → is_even_cube_above_100' n :=
λ hn, ⟨hn.even, hn.is_cube, hn.gt_100⟩

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que
--    even_natural_number' → even_natural_number
-- ----------------------------------------------------------------------

-- 1ª demostración
example : even_natural_number' → even_natural_number :=
λ n,
{ even_natural_number .
  n      := n.1,
  even_n := n.2 }

-- 2ª demostración
example : even_natural_number' → even_natural_number :=
λ n,
{ n      := n.1,
  even_n := n.2 }

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que, para todo número natural n,
--    is_even_cube_above_100' n → is_even_cube_above_100 n
-- ----------------------------------------------------------------------

example
  (n : ℕ)
  : is_even_cube_above_100' n → is_even_cube_above_100 n :=
λ ⟨h1n, h2n, h3n⟩,
{ even    := h1n,
  is_cube := h2n,
  gt_100  := h3n }

-- ---------------------------------------------------------------------
-- Ejercicio. Definir la función
--    bounds' : (ℕ → ℕ) → Type
-- tal que (bound' f) es el subtipo de las cotas superiores de f.
-- ----------------------------------------------------------------------

def bounds' (f : ℕ → ℕ) : Type :=
{ n : ℕ // ∀ (m : ℕ), f m ≤ n }

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que para toda f,
--    bounds f → bounds' f
-- ----------------------------------------------------------------------

example
  (f : ℕ → ℕ)
  : bounds f → bounds' f :=
λ ⟨n, hn⟩, ⟨n, hn⟩

-- ----------------------------------------------------------------------
-- Ejercicio. Demostrar que para toda f,
--    bounds' f → bounds f
-- ----------------------------------------------------------------------

example
  (f : ℕ → ℕ)
  : bounds' f → bounds f :=
λ n, { bound := n.1, le_bound := n.2 }

------------------------------------------------------------------------
-- § Clases                                                           --
------------------------------------------------------------------------

-- ---------------------------------------------------------------------
-- Ejercicio. Definir la clase
--    is_square : ℕ → Prop
-- tal que (is_square n) si n es un cuadrado.
-- ----------------------------------------------------------------------

@[class]
def is_square (n : ℕ) : Prop :=
  ∃k : ℕ, k^2 = n

-- ---------------------------------------------------------------------
-- Ejercicio. Iniciar el espacio de nombres is_square.
-- ----------------------------------------------------------------------

namespace is_square

-- ---------------------------------------------------------------------
-- Ejercicio. Definir la función
--    sqrt : ℕ → ℕ
-- tal que, si n es un número cuadrado, entonces (sqrt n) es su raíz
-- cuadrada.
-- ----------------------------------------------------------------------

def sqrt (n : ℕ) [hn : is_square n] : ℕ := classical.some hn

-- Comentario: Se ha usado el lema
-- + classical.some : (∃ (x : ℕ), p x) → ℕ [2 times]

-- ---------------------------------------------------------------------
-- Ejercicio. Definir √ como notación para la raíz cuadrada.
-- ----------------------------------------------------------------------

prefix `√`:(max+1) := sqrt

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que si n es un cuadrado, entonces
--    (√n) ^ 2 = n
-- y declararlo como regla de simplificación
-- ----------------------------------------------------------------------

@[simp] lemma square_sqrt
  (n : ℕ)
  [hn : is_square n]
  : (√n) ^ 2 = n :=
classical.some_spec hn

-- Comentario: Se ha usado el lema
-- + classical.some_spec : ∀ (h : ∃ (x : ℕ), p x), p (classical.some h)

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que si n es un número cuadrado, entonces
--    √n = k ↔ n = k^2
-- ----------------------------------------------------------------------

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

example
  (n k : ℕ)
  [is_square n]
  : √n = k ↔ n = k^2 :=
begin
  split,
  { intro h,
    rw ← h,
    exact (square_sqrt n).symm },
  { intro h,
    apply pow_left_inj (nat.zero_le _) (nat.zero_le k) two_pos,
    simp [h] },
end

-- Comentario: Se usan los lemas
-- + pow_left_inj : 0 ≤ x → 0 ≤ y → 0 < n → x ^ n = y ^ n → x = y
-- + zero_le : ∀ (n : ℕ), 0 ≤ n
-- + two_pos : 0 < 2

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

@[simp] lemma sqrt_eq_iff
  (n k : ℕ)
  [is_square n]
  : √n = k ↔ n = k^2 :=
begin
  split;
  intro h,
  { simp [← h] },
  { exact pow_left_inj (nat.zero_le _) (nat.zero_le k) two_pos (by simp [h]) }
end

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que n^2 es un cuadrado y declararlo como
-- instancia (para aplicarlo directamente en las inferencias de clases).
-- ----------------------------------------------------------------------

instance square_square
  (n : ℕ)
  : is_square (n^2) :=
⟨n, rfl⟩

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que
--    √(n ^ 2) 0 n
-- ----------------------------------------------------------------------

lemma sqrt_square
  (n : ℕ)
  : √(n ^ 2) = n :=
by simp

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que el producto de dos cuadrados es un cuadrado
-- (y declarlo como instancia)
-- ----------------------------------------------------------------------

example
  (n m : ℕ)
  [is_square n]
  [is_square m]
  : is_square (n*m) :=
begin
  use (√n * √m),
  rw nat.mul_pow,
  rw square_sqrt,
  rw square_sqrt,
end

-- Prueba
-- ======

/-
n m : ℕ,
_inst_1 : is_square n,
_inst_2 : is_square m
⊢ is_square (n * m)
  >> use (√n * √m),
⊢ (√n * √m) ^ 2 = n * m
  >> rw nat.mul_pow,
⊢ √n ^ 2 * √m ^ 2 = n * m
  >> rw square_sqrt,
⊢ n * √m ^ 2 = n * m
  >> rw square_sqrt,
no goals
-/

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

instance square_mul
  (n m : ℕ)
  [is_square n]
  [is_square m]
  : is_square (n*m) :=
⟨√n * √m, by simp [nat.mul_pow]⟩

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que si n y m son cuadrados, entonces
--    √(n * m) = √n * √m
-- ----------------------------------------------------------------------

lemma sqrt_mul
  (n m : ℕ)
  [is_square n]
  [is_square m]
  : √(n * m) = √n * √m :=
by simp [nat.mul_pow]

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que si n es un cuadrado, entonces
--    √(n * m ^ 2) = √n * m
-- ----------------------------------------------------------------------

example
  (n m : ℕ)
  [is_square n]
  : √(n * m ^ 2) = √n * m :=
by simp [sqrt_mul, sqrt_square]

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que si n es un cuadrado, entonces
--    √n ≤ n
-- ----------------------------------------------------------------------

lemma sqrt_le
  (n : ℕ)
  [is_square n]
  : √n ≤ n :=
begin
  conv_rhs { rw [← square_sqrt n, nat.pow_two] },
             apply nat.le_mul_self
end

-- Comentario: Se han usado los lemas
-- + nat.le_mul_self : n ≤ n * n
-- + nat.pow_two : n ^ 2 = n * n

-- ---------------------------------------------------------------------
-- Ejercicio. Cerrar el espacio de nombres is_square.
-- ----------------------------------------------------------------------

end is_square

-- ---------------------------------------------------------------------
-- Ejercicio. Iniciar la sección bijections.
-- ----------------------------------------------------------------------

section bijections

-- ---------------------------------------------------------------------
-- Ejercicio. Abrir la teoría function.
-- ----------------------------------------------------------------------

open function

-- ---------------------------------------------------------------------
-- Ejercicio. Declarar α y β como variables de tipo.
-- ----------------------------------------------------------------------

variables {α β : Type*}

-- ---------------------------------------------------------------------
-- Ejercicio. Obtener la información de la estructura equiv.
-- ----------------------------------------------------------------------

#print equiv

-- Comentario: Al colocar el cursor sobre print se obtiene
--    structure equiv :
--      Sort u_1 → Sort u_2 → Sort (max 1 (imax u_1 u_2) (imax u_2 u_1))
--    fields:
--    equiv.to_fun : Π {α : Sort u_1} {β : Sort u_2}, α ≃ β → α → β
--    equiv.inv_fun : Π {α : Sort u_1} {β : Sort u_2}, α ≃ β → β → α
--    equiv.left_inv : ∀ {α : Sort u_1} {β : Sort u_2} (c : α ≃ β),
--                     left_inverse c.inv_fun c.to_fun
--    equiv.right_inv : ∀ {α : Sort u_1} {β : Sort u_2} (c : α ≃ β),
--                      right_inverse c.inv_fun c.to_fun
--
-- Su definición es
--    structure equiv (α β : Type*) :=
--    (to_fun    : α → β)
--    (inv_fun   : β → α)
--    (left_inv  : left_inverse inv_fun to_fun)
--    (right_inv : right_inverse inv_fun to_fun)
-- Es decir, da una equivalencia (biyección) entre dos tipos.

-- ---------------------------------------------------------------------
-- Ejercicio. Definir la estructura biyection que afirma la existencia
-- de una aplicación inyectiva y suprayectiva entre los tipos.
-- ----------------------------------------------------------------------

structure bijection (α β : Type*) :=
  (to_fun : α → β)
  (injective : injective to_fun)
  (surjective : surjective to_fun)

-- ---------------------------------------------------------------------
-- Ejercicio. Declarar bijection como una instancia de has_coe_to_fun
-- para tratar las biyecciones como funciones.
-- ----------------------------------------------------------------------

instance : has_coe_to_fun (bijection α β) :=
⟨_, λ f, f.to_fun⟩

-- ---------------------------------------------------------------------
-- Ejercicio. Ampliar la táctica de extensionalidad a las biyecciones.
-- ----------------------------------------------------------------------

@[ext]
def bijection.ext
  {f g : bijection α β}
  (hfg : ∀ x, f x = g x)
  : f = g :=
by { cases f, cases g, congr, ext, exact hfg x }

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar el lema coe_mk para reducir la aplicación de una
-- biyección a un argumento.
-- ----------------------------------------------------------------------

@[simp]
lemma coe_mk
  {f : α → β}
  {h1f : injective f}
  {h2f : surjective f}
  {x : α}
  : { bijection . to_fun := f,
      injective := h1f,
      surjective := h2f } x = f x :=
 rfl

-- ---------------------------------------------------------------------
-- Ejercicio. Definir equiv_of_bijection tal que, si f es una biyección
-- de α en β entonces (equiv_of_bijection f) es una equivalencia entre α
-- y β.
-- ----------------------------------------------------------------------

def equiv_of_bijection (f : bijection α β) : α ≃ β :=
begin
  exact equiv.of_bijective f ⟨f.injective, f.surjective⟩
end

-- ---------------------------------------------------------------------
-- Ejercicio. Definir bijection_of_equiv tal que si f es una
-- equivalencia entre α y β, entonces (bijection_of_equiv f) es una
-- biyección de α en β.
-- ----------------------------------------------------------------------

def bijection_of_equiv (f : α ≃ β) : bijection α β :=
{ to_fun := f,
  injective := f.injective,
  surjective := f.surjective }

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que las biyecciones son equivalentes a las
-- equivalencias.
-- ----------------------------------------------------------------------

def bijection_equiv_equiv : bijection α β ≃ (α ≃ β) :=
{ to_fun := equiv_of_bijection,
  inv_fun := bijection_of_equiv,
  left_inv :=
    by { intro f, ext, simp [bijection_of_equiv, equiv_of_bijection] },
  right_inv :=
    by { intro f, ext, simp [bijection_of_equiv, equiv_of_bijection] } }

-- ---------------------------------------------------------------------
-- Ejercicio. Cerrar la sección bijections
-- ----------------------------------------------------------------------

end bijections

-- ---------------------------------------------------------------------
-- Ejercicio. Definir la estructura Group que tiene
--    + universo: G,
--    + operación interna: op (representada por *)
--    + elemento neutro por la izquierda: id (representado por 1)
--    + inverso por la izquierda inv (representado por ⁻¹)
-- y verifica los axiomas
--    + asociativa: ∀ (x y z : G), (x * y) * z = x * (y * z)
--    + neutro: ∀ (x : G), 1 * x = x)
--    + inverso: ∀ (x : G), x⁻¹ * x = 1
-- ----------------------------------------------------------------------

structure Group :=
  (G : Type*)
  (op : G → G → G) (infix *    := op)
  (id : G)         (notation 1 := id)
  (inv : G → G)    (postfix ⁻¹ := inv)
  (op_assoc' : ∀ (x y z : G), (x * y) * z = x * (y * z))
  (id_op' : ∀ (x : G), 1 * x = x)
  (op_left_inv' : ∀ (x : G), x⁻¹ * x = 1)

-- ---------------------------------------------------------------------
-- Ejercicio. Extender la estructura Group a CommGroup de los grupos
-- conmutativos.
-- ----------------------------------------------------------------------

structure CommGroup extends Group :=
  (infix * := op)
  (op_comm : ∀ (x y : G), x * y = y * x)

-- ---------------------------------------------------------------------
-- Ejercicio. Definir el grupo aditivo de los racionales.
-- ----------------------------------------------------------------------

def rat_Group : Group :=
{ G := ℚ,
  op := (+),
  id := 0,
  inv := λ x, -x,
  op_assoc' := add_assoc,
  id_op' := zero_add,
  op_left_inv' := neg_add_self }

-- ---------------------------------------------------------------------
-- Ejercicio. Extender el grupo aditivo de los racionales a grupo
-- conmutativo.
-- ----------------------------------------------------------------------

def rat_CommGroup : CommGroup :=
{ G := ℚ,
  op_comm := add_comm,
  ..rat_Group }

-- ---------------------------------------------------------------------
-- Ejercicio. Iniciar el espacio de nombres Group
-- ----------------------------------------------------------------------

namespace Group

-- ---------------------------------------------------------------------
-- Ejercicio. Declarar G como una variable sobre grupos.
-- ----------------------------------------------------------------------

variables {G : Group}

-- ---------------------------------------------------------------------
-- Ejercicio. Declarar los grupos como instancias de tipos.
-- ----------------------------------------------------------------------

instance : has_coe_to_sort Group := ⟨_, Group.G⟩

-- ---------------------------------------------------------------------
-- Ejercicio. Declarar que G tiene
--    + multiplicación: op (o *)
--    + neutro: id (o 1)
--    + inverso: inv (o ⁻¹)
-- ----------------------------------------------------------------------

instance : has_mul G := ⟨G.op⟩
instance : has_one G := ⟨G.id⟩
instance : has_inv G := ⟨G.inv⟩

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que G cumple los axiomas de grupo.
-- ----------------------------------------------------------------------

lemma op_assoc
  (x y z : G)
  : (x * y) * z = x * (y * z) :=
G.op_assoc' x y z

lemma id_op
  (x : G)
  : 1 * x = x :=
G.id_op' x

lemma op_left_inv
  (x : G)
  : x⁻¹ * x = 1 :=
  G.op_left_inv' x

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que si G es un grupo y x es un elemento de G,
-- entonces
--    x * x = x → x = 1
-- ----------------------------------------------------------------------

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

example
  {G : Group}
  {x : G}
  : x * x = x → x = 1 :=
begin
  intro hx,
  rw ← id_op x,
  rw ← op_left_inv x,
  rw op_assoc,
  rw hx,
end

-- Prueba
-- ======

/-
G : Group,
x : ↥G
⊢ x * x = x → x = 1
  >> intro hx,
hx : x * x = x
⊢ x = 1
  >> rw ← id_op x,
⊢ 1 * x = 1
  >> rw ← op_left_inv x,
⊢ (x⁻¹ * x) * x = x⁻¹ * x
  >> rw op_assoc,
⊢ x⁻¹ * (x * x) = x⁻¹ * x
  >> rw hx,
no goals
-/

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

lemma eq_id_of_op_eq_self
  {G : Group}
  {x : G}
  : x * x = x → x = 1 :=
begin
  intro hx,
  rw [← id_op x, ← op_left_inv x, op_assoc, hx]
end

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que x⁻¹ es el inverso de x por la derecha.
-- ----------------------------------------------------------------------

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

example
  {G : Group}
  (x : G)
  : x * x⁻¹ = 1 :=
begin
  apply eq_id_of_op_eq_self,
  rw op_assoc x x⁻¹ (x * x⁻¹),
  rw ← op_assoc x⁻¹ x x⁻¹,
  rw op_left_inv,
  rw id_op,
end

-- Prueba
-- ======

/-
G : Group,
x : ↥G
⊢ x * x⁻¹ = 1
  >> apply eq_id_of_op_eq_self,
⊢ (x * x⁻¹) * (x * x⁻¹) = x * x⁻¹
  >> rw op_assoc x x⁻¹ (x * x⁻¹),
⊢ x * (x⁻¹ * (x * x⁻¹)) = x * x⁻¹
  >> rw ← op_assoc x⁻¹ x x⁻¹,
⊢ x * ((x⁻¹ * x) * x⁻¹) = x * x⁻¹
  >> rw op_left_inv,
⊢ x * (1 * x⁻¹) = x * x⁻¹
  >> rw id_op,
no goals
-/

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

lemma op_right_inv
  {G : Group}
  (x : G)
  : x * x⁻¹ = 1 :=
begin
  apply eq_id_of_op_eq_self,
  rw [op_assoc x x⁻¹ (x * x⁻¹), ← op_assoc x⁻¹ x x⁻¹, op_left_inv, id_op]
end

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que 1 es neutro por la derecha.
-- ----------------------------------------------------------------------

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

example
  {G : Group}
  (x : G)
  : x * 1 = x :=
begin
  rw ← op_left_inv x,
  rw ← op_assoc,
  rw op_right_inv,
  rw id_op,
end

-- Prueba
-- ======

/-
G : Group,
x : ↥G
⊢ x * 1 = x
  >> rw ← op_left_inv x,
⊢ x * (x⁻¹ * x) = x
  >> rw ← op_assoc,
⊢ (x * x⁻¹) * x = x
  >> rw op_right_inv,
⊢ 1 * x = x
  >> rw id_op,
no goals
-/

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

lemma op_id
  {G : Group}
  (x : G)
  : x * 1 = x :=
by rw [← op_left_inv x, ← op_assoc, op_right_inv, id_op]

-- ---------------------------------------------------------------------
-- Ejercicio. Definir el producto cartesiano de dos grupos.
-- ----------------------------------------------------------------------

def prod_Group (G₁ G₂ : Group) : Group :=
{ G := G₁ × G₂,
  op := λ x y, (x.1 * y.1, x.2 * y.2),
  op_assoc' := by { intros, ext; simp; rw [op_assoc] },
  id := (1, 1),
  id_op' := by { intros, ext; simp; rw [id_op] },
  inv := λ x, (x.1⁻¹, x.2⁻¹),
  op_left_inv' := by { intros, ext; simp; rw [op_left_inv] } }

-- ---------------------------------------------------------------------
-- Ejercicio. Cerrar el espacio de nombres Group
-- ----------------------------------------------------------------------

end Group

-- ---------------------------------------------------------------------
-- Ejercicio. Definir la estructura pointed_type cuyos campos son
-- + type que es un tipo y
-- + point que es un elemento de type.
-- ----------------------------------------------------------------------

structure pointed_type :=
(type : Type*)
(point : type)

-- ---------------------------------------------------------------------
-- Ejercicio. Empezar el espacio de nombre pointed_type.
-- ----------------------------------------------------------------------

namespace pointed_type

-- ---------------------------------------------------------------------
-- Ejercicio. Declarar A y B como variables sobre pointed_type
-- ----------------------------------------------------------------------

variables {A B : pointed_type}

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que si A es un pointed_type entonces es un tipo.
-- ----------------------------------------------------------------------

instance : has_coe_to_sort pointed_type := ⟨_, pointed_type.type⟩

-- ---------------------------------------------------------------------
-- Ejercicio. Definir el producto de pointed_type.
-- ----------------------------------------------------------------------

@[simps point]
def prod (A B : pointed_type) : pointed_type :=
{ type := A × B,
  point := (A.point, B.point) }

-- Comentario: El atributo @[simps point] indica que se puede desplegar
-- la definición.

-- ---------------------------------------------------------------------
-- Ejercicio. Terminar el espacio de nombres de pointed_type.
-- ----------------------------------------------------------------------

end pointed_type

structure pointed_map (A B : pointed_type) :=
(to_fun : A → B)
(to_fun_point : to_fun A.point = B.point)

namespace pointed_map

infix ` →. `:25 := pointed_map

variables {A B C D : pointed_type}
variables {h : C →. D} {g : B →. C} {f f₁ f₂ : A →. B}

instance : has_coe_to_fun (A →. B) := ⟨λ _, A → B, pointed_map.to_fun⟩

@[simp] lemma coe_mk {f : A → B} {hf : f A.point = B.point} {x : A} :
  { pointed_map . to_fun := f, to_fun_point := hf } x = f x := rfl
@[simp] lemma coe_point : f A.point = B.point := f.to_fun_point

@[ext] protected lemma ext (hf₁₂ : ∀ x, f₁ x = f₂ x) : f₁ = f₂ :=
begin
  cases f₁ with f₁ hf₁, cases f₂ with f₂ hf₂, congr, ext x, exact hf₁₂ x
end

/-! Below we show that pointed types form a category. -/

def comp (g : B →. C) (f : A →. B) : A →. C :=
{ to_fun := g ∘ f,
  to_fun_point := by simp }

def id : A →. A :=
{ to_fun := id,
  to_fun_point := by simp }

/-! You can use projection notation for any declaration declared in the same namespace as the
  structure. For example, `g.comp f` means `pointed_map.comp g f` -/
lemma comp_assoc : h.comp (g.comp f) = (h.comp g).comp f :=
by { ext x, refl }

lemma id_comp : f.comp id = f :=
by { ext x, refl }

lemma comp_id : id.comp f = f :=
by { ext x, refl }

/-! Below we show that `A.prod B` (that is, `pointed_type.prod A B`) is a product in the category of
  pointed types. -/

def fst : A.prod B →. A :=
{ to_fun := prod.fst,
  to_fun_point := rfl }

def snd : A.prod B →. B :=
{ to_fun := prod.snd,
  to_fun_point := rfl }

def pair (f : C →. A) (g : C →. B) : C →. A.prod B :=
{ to_fun := λ c, (f c, g c),
  to_fun_point := by simp }

lemma fst_pair (f : C →. A) (g : C →. B) : fst.comp (f.pair g) = f :=
by { ext, simp [pair, fst, comp] }

lemma snd_pair (f : C →. A) (g : C →. B) : snd.comp (f.pair g) = g :=
by { ext, simp [pair, snd, comp] }

lemma pair_unique (f : C →. A) (g : C →. B) (u : C →. A.prod B) (h1u : fst.comp u = f)
  (h2u : snd.comp u = g) : u = f.pair g :=
begin
  ext,
  { have : fst (u x) = f x, { rw [←h1u], simp [comp] }, simpa using this },
  { have : snd (u x) = g x, { rw [←h2u], simp [comp] }, simpa using this }
end

end pointed_map

/-! As an advanced exercise, you can show that the category of pointed type has coproducts.
  For this we need quotients, the basic interface is given with the declarations
  `quot r`: the quotient of the equivalence relation generated by relation `r` on `A`
  `quot.mk r : A → quot r`,
  `quot.sound`
  `quot.lift` (see below)
  -/

#print quot
#print quot.mk
#print quot.sound
#print quot.lift

open sum

/-! We want to define the coproduct of pointed types `A` and `B` as the coproduct `A ⊕ B` of the
  underlying type, identifying the two basepoints.

  First define a relation that *only* relates `inl A.point ~ inr B.point`.
-/
def coprod_rel (A B : pointed_type) : (A ⊕ B) → (A ⊕ B) → Prop :=
λ x y, x = inl A.point ∧ y = inr B.point

namespace pointed_type

-- @[simps point]
-- omit
@[simps point]
-- omit
def coprod (A B : pointed_type) : pointed_type :=
{ type := quot (coprod_rel A B),
  point := quot.mk _ (inl A.point) }
end pointed_type

namespace pointed_map

variables {A B C D : pointed_type}

def inl : A →. A.coprod B :=
{ to_fun := quot.mk _ ∘ sum.inl,
  to_fun_point := rfl }

def inr : B →. A.coprod B :=
{ to_fun := quot.mk _ ∘ sum.inr,
  to_fun_point := by { refine (quot.sound _).symm, exact ⟨rfl, rfl⟩ } }

def elim (f : A →. C) (g : B →. C) : A.coprod B →. C :=
{ to_fun := quot.lift (sum.elim f g) (by { rintro _ _ ⟨rfl, rfl⟩, simp }),
  to_fun_point := by simp }

lemma elim_comp_inl (f : A →. C) (g : B →. C) : (f.elim g).comp inl = f :=
by { ext, simp [elim, inl, comp] }

lemma elim_comp_inr (f : A →. C) (g : B →. C) : (f.elim g).comp inr = g :=
by { ext, simp [elim, inr, comp] }

lemma elim_unique (f : A →. C) (g : B →. C) (u : A.coprod B →. C) (h1u : u.comp inl = f)
  (h2u : u.comp inr = g) : u = f.elim g :=
begin
  ext (x|y),
  { have : u (inl x) = f x, { rw [←h1u], simp [comp] }, simpa [elim, inl] using this },
  { have : u (inr y) = g y, { rw [←h2u], simp [comp] }, simpa [elim, inl] using this }
end

end pointed_map

-- Comprobación de la corrección sintáctica
#lint

------------------------------------------------------------------------
-- § Referencia                                                       --
------------------------------------------------------------------------

-- Basado en la teoría structures.lean de Floris van Doorn que se
-- encuentra en https://bit.ly/39s7AwF y se comenta en los vídeos
-- "Structures and Classes" que se encuentra en
-- https://youtu.be/xYenPIeX6MY


/-
Copyright (c) 2019 Michael Howes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Michael Howes
-/
import group_theory.free_group
import group_theory.quotient_group

/-!
# Defining a group given by generators and relations

Given a subset `rels` of relations of the free group on a type `α`, this file constructs the group
given by generators `x : α` and relations `r ∈ rels`.

## Main definitions

* `presented_group rels`: the quotient group of the free group on a type `α` by a subset `rels` of
  relations of the free group on `α`.
* `of`: The canonical map from `α` to a presented group with generators `α`.
* `to_group f`: the canonical group homomorphism `presented_group rels → G`, given a function
  `f : α → G` from a type `α` to a group `G` which satisfies the relations `rels`.

## Tags

generators, relations, group presentations
-/

variables {α : Type}

/-- Given a set of relations, rels, over a type `α`, presented_group constructs the group with
generators `x : α` and relations `rels` as a quotient of free_group `α`.-/
def presented_group (rels : set (free_group α)) : Type :=
quotient_group.quotient $ subgroup.normal_closure rels

namespace presented_group

instance (rels : set (free_group α)) : group (presented_group (rels)) :=
quotient_group.quotient.group _

/-- `of` is the canonical map from `α` to a presented group with generators `x : α`. The term `x` is
mapped to the equivalence class of the image of `x` in `free_group α`. -/
def of {rels : set (free_group α)} (x : α) : presented_group rels :=
quotient_group.mk (free_group.of x)

section to_group

/-
Presented groups satisfy a universal property. If `G` is a group and `f : α → G` is a map such that
the images of `f` satisfy all the given relations, then `f` extends uniquely to a group homomorphism
from `presented_group rels` to `G`.
-/

variables {G : Type} [group G] {f : α → G} {rels : set (free_group α)}

local notation `F` := free_group.lift f

variable (h : ∀ r ∈ rels, F r = 1)

lemma closure_rels_subset_ker : subgroup.normal_closure rels ≤ monoid_hom.ker F :=
subgroup.normal_closure_le_normal (λ x w, (monoid_hom.mem_ker _).2 (h x w))

lemma to_group_eq_one_of_mem_closure : ∀ x ∈ subgroup.normal_closure rels, F x = 1 :=
λ x w, (monoid_hom.mem_ker _).1 $ closure_rels_subset_ker h w

/-- The extension of a map `f : α → G` that satisfies the given relations to a group homomorphism
from `presented_group rels → G`. -/
def to_group : presented_group rels →* G :=
quotient_group.lift (subgroup.normal_closure rels) F (to_group_eq_one_of_mem_closure h)

@[simp] lemma to_group.of {x : α} : to_group h (of x) = f x := free_group.lift.of

theorem to_group.unique (g : presented_group rels →* G)
  (hg : ∀ x : α, g (of x) = f x) : ∀ {x}, g x = to_group h x :=
λ x, quotient_group.induction_on x
    (λ _, free_group.lift.unique (g.comp (quotient_group.mk' _)) hg)

end to_group

instance (rels : set (free_group α)) : inhabited (presented_group rels) := ⟨1⟩

end presented_group


/-
Copyright (c) 2019 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Benjamin Davidson
-/
import data.nat.modeq

/-!
# Parity of natural numbers

This file contains theorems about the `even` and `odd` predicates on the natural numbers.

## Tags

even, odd
-/

namespace nat

variables {m n : ℕ}

@[simp] theorem mod_two_ne_one : ¬ n % 2 = 1 ↔ n % 2 = 0 :=
by cases mod_two_eq_zero_or_one n with h h; simp [h]

@[simp] theorem mod_two_ne_zero : ¬ n % 2 = 0 ↔ n % 2 = 1 :=
by cases mod_two_eq_zero_or_one n with h h; simp [h]

theorem even_iff : even n ↔ n % 2 = 0 :=
⟨λ ⟨m, hm⟩, by simp [hm], λ h, ⟨n / 2, (mod_add_div n 2).symm.trans (by simp [h])⟩⟩

theorem odd_iff : odd n ↔ n % 2 = 1 :=
⟨λ ⟨m, hm⟩, by norm_num [hm, add_mod],
 λ h, ⟨n / 2, (mod_add_div n 2).symm.trans (by rw [h, add_comm])⟩⟩

lemma not_even_iff : ¬ even n ↔ n % 2 = 1 :=
by rw [even_iff, mod_two_ne_zero]

lemma not_odd_iff : ¬ odd n ↔ n % 2 = 0 :=
by rw [odd_iff, mod_two_ne_one]

lemma even_iff_not_odd : even n ↔ ¬ odd n :=
by rw [not_odd_iff, even_iff]

@[simp] lemma odd_iff_not_even : odd n ↔ ¬ even n :=
by rw [not_even_iff, odd_iff]

lemma is_compl_even_odd : is_compl {n : ℕ | even n} {n | odd n} :=
by simp [← set.compl_set_of, is_compl_compl]

lemma even_or_odd (n : ℕ) : even n ∨ odd n :=
or.imp_right odd_iff_not_even.2 $ em $ even n

lemma even_or_odd' (n : ℕ) : ∃ k, n = 2 * k ∨ n = 2 * k + 1 :=
by simpa only [exists_or_distrib, ← odd, ← even] using even_or_odd n

lemma even_xor_odd (n : ℕ) : xor (even n) (odd n) :=
begin
  cases even_or_odd n with h,
  { exact or.inl ⟨h, even_iff_not_odd.mp h⟩ },
  { exact or.inr ⟨h, odd_iff_not_even.mp h⟩ },
end

lemma even_xor_odd' (n : ℕ) : ∃ k, xor (n = 2 * k) (n = 2 * k + 1) :=
begin
  rcases even_or_odd n with ⟨k, rfl⟩ | ⟨k, rfl⟩;
  use k,
  { simpa only [xor, true_and, eq_self_iff_true, not_true, or_false, and_false]
      using (succ_ne_self (2*k)).symm },
  { simp only [xor, add_right_eq_self, false_or, eq_self_iff_true, not_true, not_false_iff,
              one_ne_zero, and_self] },
end

lemma odd_gt_zero (h : odd n) : 0 < n :=
by { obtain ⟨k, rfl⟩ := h, exact succ_pos' }

@[simp] theorem two_dvd_ne_zero : ¬ 2 ∣ n ↔ n % 2 = 1 :=
not_even_iff

instance : decidable_pred (even : ℕ → Prop) :=
λ n, decidable_of_decidable_of_iff (by apply_instance) even_iff.symm

instance decidable_pred_odd : decidable_pred (odd : ℕ → Prop) :=
λ n, decidable_of_decidable_of_iff (by apply_instance) odd_iff_not_even.symm

mk_simp_attribute parity_simps "Simp attribute for lemmas about `even`"

@[simp] theorem even_zero : even 0 := ⟨0, dec_trivial⟩

@[simp] theorem not_even_one : ¬ even 1 :=
by rw even_iff; norm_num

@[simp] theorem even_bit0 (n : ℕ) : even (bit0 n) :=
⟨n, by rw [bit0, two_mul]⟩

@[parity_simps] theorem even_add : even (m + n) ↔ (even m ↔ even n) :=
by cases mod_two_eq_zero_or_one m with h₁ h₁;
   cases mod_two_eq_zero_or_one n with h₂ h₂;
   simp [even_iff, h₁, h₂, nat.add_mod];
   norm_num

theorem even.add_even (hm : even m) (hn : even n) : even (m + n) :=
even_add.2 $ iff_of_true hm hn

theorem even_add' : even (m + n) ↔ (odd m ↔ odd n) :=
by rw [even_add, even_iff_not_odd, even_iff_not_odd, not_iff_not]

theorem odd.add_odd (hm : odd m) (hn : odd n) : even (m + n) :=
even_add'.2 $ iff_of_true hm hn

@[simp] theorem not_even_bit1 (n : ℕ) : ¬ even (bit1 n) :=
by simp [bit1] with parity_simps

lemma two_not_dvd_two_mul_add_one (n : ℕ) : ¬(2 ∣ 2 * n + 1) :=
by convert not_even_bit1 n; exact two_mul n

lemma two_not_dvd_two_mul_sub_one : Π {n} (w : 0 < n), ¬(2 ∣ 2 * n - 1)
| (n + 1) _ := two_not_dvd_two_mul_add_one n

@[parity_simps] theorem even_sub (h : n ≤ m) : even (m - n) ↔ (even m ↔ even n) :=
begin
  conv { to_rhs, rw [←nat.sub_add_cancel h, even_add] },
  by_cases h : even n; simp [h]
end

theorem even.sub_even (hm : even m) (hn : even n) : even (m - n) :=
(le_total n m).elim
  (λ h, by simp only [even_sub h, *])
  (λ h, by simp only [sub_eq_zero_of_le h, even_zero])

theorem even_sub' (h : n ≤ m) : even (m - n) ↔ (odd m ↔ odd n) :=
by rw [even_sub h, even_iff_not_odd, even_iff_not_odd, not_iff_not]

theorem odd.sub_odd (hm : odd m) (hn : odd n) : even (m - n) :=
(le_total n m).elim
  (λ h, by simp only [even_sub' h, *])
  (λ h, by simp only [sub_eq_zero_of_le h, even_zero])

@[parity_simps] theorem even_succ : even (succ n) ↔ ¬ even n :=
by rw [succ_eq_add_one, even_add]; simp [not_even_one]

@[parity_simps] theorem even_mul : even (m * n) ↔ even m ∨ even n :=
by cases mod_two_eq_zero_or_one m with h₁ h₁;
   cases mod_two_eq_zero_or_one n with h₂ h₂;
   simp [even_iff, h₁, h₂, nat.mul_mod];
   norm_num

theorem odd_mul : odd (m * n) ↔ odd m ∧ odd n :=
by simp [not_or_distrib] with parity_simps

theorem even.mul_left (hm : even m) (n) : even (m * n) :=
even_mul.mpr $ or.inl hm

theorem even.mul_right (m) (hn : even n) : even (m * n) :=
even_mul.mpr $ or.inr hn

theorem odd.mul (hm : odd m) (hn : odd n) : odd (m * n) :=
odd_mul.mpr ⟨hm, hn⟩

theorem odd.of_mul_left (h : odd (m * n)) : odd m :=
(odd_mul.mp h).1

theorem odd.of_mul_right (h : odd (m * n)) : odd n :=
(odd_mul.mp h).2

/-- If `m` and `n` are natural numbers, then the natural number `m^n` is even
if and only if `m` is even and `n` is positive. -/
@[parity_simps] theorem even_pow : even (m^n) ↔ even m ∧ n ≠ 0 :=
by { induction n with n ih; simp [*, pow_succ', even_mul], tauto }

theorem even_div : even (m / n) ↔ m % (2 * n) / n = 0 :=
by rw [even_iff_two_dvd, dvd_iff_mod_eq_zero, nat.div_mod_eq_mod_mul_div, mul_comm]

@[parity_simps] theorem odd_add : odd (m + n) ↔ (odd m ↔ even n) :=
by rw [odd_iff_not_even, even_add, not_iff, odd_iff_not_even]

theorem odd.add_even (hm : odd m) (hn : even n) : odd (m + n) :=
odd_add.2 $ iff_of_true hm hn

theorem odd_add' : odd (m + n) ↔ (odd n ↔ even m) :=
by rw [add_comm, odd_add]

theorem even.add_odd (hm : even m) (hn : odd n) : odd (m + n) :=
odd_add'.2 $ iff_of_true hn hm

lemma ne_of_odd_add (h : odd (m + n)) : m ≠ n :=
λ hnot, by simpa [hnot] with parity_simps using h

@[parity_simps] theorem odd_sub (h : n ≤ m) : odd (m - n) ↔ (odd m ↔ even n) :=
by rw [odd_iff_not_even, even_sub h, not_iff, odd_iff_not_even]

theorem odd.sub_even (h : n ≤ m) (hm : odd m) (hn : even n) : odd (m - n) :=
(odd_sub h).mpr $ iff_of_true hm hn

theorem odd_sub' (h : n ≤ m) : odd (m - n) ↔ (odd n ↔ even m) :=
by rw [odd_iff_not_even, even_sub h, not_iff, not_iff_comm, odd_iff_not_even]

theorem even.sub_odd (h : n ≤ m) (hm : even m) (hn : odd n) : odd (m - n) :=
(odd_sub' h).mpr $ iff_of_true hn hm

lemma even_mul_succ_self (n : ℕ) : even (n * (n + 1)) :=
begin
  rw even_mul,
  convert n.even_or_odd,
  simp with parity_simps
end

variables {R : Type*} [ring R]

theorem neg_one_pow_eq_one_iff_even (h1 : (-1 : R) ≠ 1) : (-1 : R) ^ n = 1 ↔ even n :=
⟨λ h, n.mod_two_eq_zero_or_one.elim (dvd_iff_mod_eq_zero _ _).2
  (λ hn, by rw [neg_one_pow_eq_pow_mod_two, hn, pow_one] at h; exact (h1 h).elim),
  λ ⟨m, hm⟩, by rw [neg_one_pow_eq_pow_mod_two, hm]; simp⟩

@[simp] theorem neg_one_sq : (-1 : R) ^ 2 = 1 := by simp

alias nat.neg_one_sq ← nat.neg_one_pow_two

theorem neg_one_pow_of_even : even n → (-1 : R) ^ n = 1 :=
by { rintro ⟨c, rfl⟩, simp [pow_mul] }

theorem neg_one_pow_of_odd : odd n → (-1 : R) ^ n = -1 :=
by { rintro ⟨c, rfl⟩, simp [pow_add, pow_mul] }

-- Here are examples of how `parity_simps` can be used with `nat`.

example (m n : ℕ) (h : even m) : ¬ even (n + 3) ↔ even (m^2 + m + n) :=
by simp [*, (dec_trivial : ¬ 2 = 0)] with parity_simps

example : ¬ even 25394535 :=
by simp

end nat


import .src_07_existential_quantification

variables p q r : Prop

namespace mth1001

section or_introduction

/-
Given `p`, we know `p ∨ q`. Given `q`, we know `p ∨ q`. This is called or introduction.
The symbol `∨` is written `\or`.
-/

-- Left or introduction
example (h : p) : p ∨ q :=
or.inl h

-- Right or introduction
example (h : q) : p ∨ q :=
or.inr h

-- Tactic style
example (h : p) : p ∨ q :=
begin
  left,
  exact h,
end

-- Exercise 046:
example (h : q) : p ∨ q :=
begin
  sorry
end

/-
Recall that any result with premises can be translated into a result without premises via
implication introduction.
-/
example : p → p ∨ q :=
assume h : p,
  or.inl h

-- Exercise 047:
-- Give a tactic-style proof of the above.
example : p → p ∨ q :=
begin
  sorry
end

-- Exercise 048:
-- The following example is a little more challenging.
example : p ∧ q → p ∨ q :=
begin
  sorry
end

-- Exercise 049:
-- We return to looking at odd numbers. Refer back to the section on existential quantification.
example (n : ℤ) : (∃ m, n = 4 *m + 3) → (odd 10) ∨ (odd n) :=
begin
  sorry
end

end or_introduction

/-
SUMMARY:

* Or introduction.
* Term-style introduction using `or.inl` or `or.inr`.
* Tactic-style introduction using `left` or `right`.
-/

end mth1001


/-
Copyright (c) 2021 Eric Wieser. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Eric Wieser, Jireh Loreaux
-/
import group_theory.subsemigroup.operations
import data.fintype.basic

/-!
# Centers of magmas and semigroups

## Main definitions

* `set.center`: the center of a magma
* `subsemigroup.center`: the center of a semigroup
* `set.add_center`: the center of an additive magma
* `add_subsemigroup.center`: the center of an additive semigroup

We provide `submonoid.center`, `add_submonoid.center`, `subgroup.center`, `add_subgroup.center`,
`subsemiring.center`, and `subring.center` in other files.
-/

variables {M : Type*}

namespace set

variables (M)

/-- The center of a magma. -/
@[to_additive add_center /-" The center of an additive magma. "-/]
def center [has_mul M] : set M := {z | ∀ m, m * z = z * m}

@[to_additive mem_add_center]
lemma mem_center_iff [has_mul M] {z : M} : z ∈ center M ↔ ∀ g, g * z = z * g := iff.rfl

instance decidable_mem_center [has_mul M] [decidable_eq M] [fintype M] :
  decidable_pred (∈ center M) :=
λ _, decidable_of_iff' _ (mem_center_iff M)

@[simp, to_additive zero_mem_add_center]
lemma one_mem_center [mul_one_class M] : (1 : M) ∈ set.center M := by simp [mem_center_iff]

@[simp]
lemma zero_mem_center [mul_zero_class M] : (0 : M) ∈ set.center M := by simp [mem_center_iff]

variables {M}

@[simp, to_additive add_mem_add_center]
lemma mul_mem_center [semigroup M] {a b : M}
  (ha : a ∈ set.center M) (hb : b ∈ set.center M) : a * b ∈ set.center M :=
λ g, by rw [mul_assoc, ←hb g, ← mul_assoc, ha g, mul_assoc]

@[simp, to_additive neg_mem_add_center]
lemma inv_mem_center [group M] {a : M} (ha : a ∈ set.center M) : a⁻¹ ∈ set.center M :=
λ g, by rw [← inv_inj, mul_inv_rev, inv_inv, ← ha, mul_inv_rev, inv_inv]

@[simp]
lemma add_mem_center [distrib M] {a b : M}
  (ha : a ∈ set.center M) (hb : b ∈ set.center M) : a + b ∈ set.center M :=
λ c, by rw [add_mul, mul_add, ha c, hb c]

@[simp]
lemma neg_mem_center [ring M] {a : M} (ha : a ∈ set.center M) : -a ∈ set.center M :=
λ c, by rw [←neg_mul_comm, ha (-c), neg_mul_comm]

@[to_additive subset_add_center_add_units]
lemma subset_center_units [monoid M] :
  (coe : Mˣ → M) ⁻¹' center M ⊆ set.center Mˣ :=
λ a ha b, units.ext $ ha _

lemma center_units_subset [group_with_zero M] :
  set.center Mˣ ⊆ (coe : Mˣ → M) ⁻¹' center M :=
λ a ha b, begin
  obtain rfl | hb := eq_or_ne b 0,
  { rw [zero_mul, mul_zero], },
  { exact units.ext_iff.mp (ha (units.mk0 _ hb)) }
end

/-- In a group with zero, the center of the units is the preimage of the center. -/
lemma center_units_eq [group_with_zero M] :
  set.center Mˣ = (coe : Mˣ → M) ⁻¹' center M :=
subset.antisymm center_units_subset subset_center_units

@[simp]
lemma inv_mem_center₀ [group_with_zero M] {a : M} (ha : a ∈ set.center M) : a⁻¹ ∈ set.center M :=
begin
  obtain rfl | ha0 := eq_or_ne a 0,
  { rw inv_zero, exact zero_mem_center M },
  rcases is_unit.mk0 _ ha0 with ⟨a, rfl⟩,
  rw ←units.coe_inv,
  exact center_units_subset (inv_mem_center (subset_center_units ha)),
end

@[simp, to_additive sub_mem_add_center]
lemma div_mem_center [group M] {a b : M} (ha : a ∈ set.center M) (hb : b ∈ set.center M) :
  a / b ∈ set.center M :=
begin
  rw [div_eq_mul_inv],
  exact mul_mem_center ha (inv_mem_center hb),
end

@[simp]
lemma div_mem_center₀ [group_with_zero M] {a b : M} (ha : a ∈ set.center M)
  (hb : b ∈ set.center M) : a / b ∈ set.center M :=
begin
  rw div_eq_mul_inv,
  exact mul_mem_center ha (inv_mem_center₀ hb),
end

variables (M)

@[simp, to_additive add_center_eq_univ]
lemma center_eq_univ [comm_semigroup M] : center M = set.univ :=
subset.antisymm (subset_univ _) $ λ x _ y, mul_comm y x

end set

namespace subsemigroup
section
variables (M) [semigroup M]

/-- The center of a semigroup `M` is the set of elements that commute with everything in `M` -/
@[to_additive "The center of a semigroup `M` is the set of elements that commute with everything in
`M`"]
def center : subsemigroup M :=
{ carrier := set.center M,
  mul_mem' := λ a b, set.mul_mem_center }

@[to_additive] lemma coe_center : ↑(center M) = set.center M := rfl

variables {M}

@[to_additive] lemma mem_center_iff {z : M} : z ∈ center M ↔ ∀ g, g * z = z * g := iff.rfl

@[to_additive]
instance decidable_mem_center [decidable_eq M] [fintype M] : decidable_pred (∈ center M) :=
λ _, decidable_of_iff' _ mem_center_iff

/-- The center of a semigroup is commutative. -/
@[to_additive "The center of an additive semigroup is commutative."]
instance : comm_semigroup (center M) :=
{ mul_comm := λ a b, subtype.ext $ b.prop _,
  .. mul_mem_class.to_semigroup (center M) }

end

section
variables (M) [comm_semigroup M]

@[to_additive, simp] lemma center_eq_top : center M = ⊤ :=
set_like.coe_injective (set.center_eq_univ M)

end

end subsemigroup


import M40001.M40001_C2

/-
Exercise 4.
Let us define the binary relation ~> as follow:
Let X and Y be two sets, and f : X → V be some function between the sets, then ∀ x, y ∈ X, x ~> y if and only if f(x) = f(y).

Can you prove that ~> is an equivalence relation?
Replace the sorry for your proof.

Here are some basic tactics that might help : http://wwwf.imperial.ac.uk/~buzzard/xena/html/source/tactics/guide.html
-/

universe u
variables {X V : Type u}

def bin_rel (X) := X → X → Prop
def equivalence_rel (r : bin_rel X) := reflexive r ∧ symmetric r ∧ transitive r
def cls (r : bin_rel X) (s : X) := {x : X | r s x}
def partition (A : set (set X)) : Prop := (∀ x : X, (∃ B ∈ A, x ∈ B ∧ ∀ C ∈ A, x ∈ C → B = C)) ∧ ∅ ∉ A
def rs (A : set (set(X))) (s t : X) := ∃ B ∈ A, s ∈ B ∧ t ∈ B
-- The code above is simply used to esablish the definitions!

theorem partition_equiv_relation -- I have defined rs to be: def rs (A : set (set(X))) (s t : X) := ∃ B ∈ A, s ∈ B ∧ t ∈ B
    (C : set (set X)) (h : partition C) : equivalence_rel (rs C) :=
begin
    split,
-- Proving reflexivity
    {intro x,
    cases h with ha hb,
    replace ha:
        ∃ (B : set X) (H : B ∈ C), x ∈ B ∧ ∀ (D : set X), D ∈ C → x ∈ D → B = D := ha x,
    rcases ha with ⟨ha, ⟨hb, ⟨hc, hd⟩⟩⟩,
    use ha, use hb,
    split,
    repeat {assumption}
    },
-- Proving symmtric
    {split,
        {rintros x y ⟨ha, ⟨hb, ⟨hc, hd⟩⟩⟩,
        use ha, use hb,
        split,
        repeat {assumption}
        },
-- Proving transitivity
        {rintros x y z ⟨ha, ⟨hb, ⟨hd, he⟩⟩⟩ ⟨hf, ⟨hg, ⟨hk, hl⟩⟩⟩,
        use ha, use hb,
        cases h with hm hn,
        replace hm :
            ∃ (B : set X) (H : B ∈ C), y ∈ B ∧ ∀ (D : set X), D ∈ C → y ∈ D → B = D := hm y,
        rcases hm with ⟨ho, ⟨hp, ⟨hq, hr⟩⟩⟩,
        have : hf = ha,
            {suffices : hf = ho, {rw this, apply hr ha, repeat {assumption}},
            rwa hr hf, repeat {assumption},
            },
        split,
        {assumption},
        {rwa ←this},
        }
    }
end