/-
# Function world.

## Level 5: `P → (Q → P)`.

In this level, our goal is to construct a function, like in level 2.

```
⊢ P → (Q → P)
```

So $P$ and $Q$ are sets, and our goal is to construct a function
which takes an element of $P$ and outputs a function from $Q$ to $P$.
We don't know anything at all about the sets $P$ and $Q$, so initially
this seems like a bit of a tall order. But let's give it a go. Delete
the `sorry` and let's think about how to proceed.

Our goal is `P → X` for some set $X=\operatorname{Hom}(Q,P)$, and if our
goal is to construct a function then we almost always want to use the
`intro` tactic from level 2, Lean's version of "let $p\in P$ be arbitrary."
So let's start with

`intro p,`

and we then find ourselves in this state:

```
P Q : Type,
p : P
⊢ Q → P
```

We now have an arbitrary element $p\in P$ and we are supposed to be constructing
a function $Q\to P$. Well, how about the constant function, which sends everything to $p$?
This will work. So let $q\in Q$ be arbitrary:

`intro q,`

and then let's output `p`.

`exact p,`
-/

/- Definition
We define an element of $\operatorname{Hom}(P,\operatorname{Hom}(Q,P))$.
-/
example (P Q : Type) : P → (Q → P) :=
begin
  intro p,
  intro q,
  exact p,

end

/-
A mathematician would treat the set `P → (Q → P)` as the same as the set `P × Q → P`,
because to give an element of either function space is just to give a rule which takes
an element of $P$ and an element of $Q$, and returns an element of $P$. Thinking of the
goal as a function from `P × Q` to `P` we realise that it's just projection onto the first
factor.

## Did you notice?

I wrote `P → (Q → P)` but Lean just writes `P → Q → P`. This is because
computer scientists adopt the convention that `→` is *right associative*,
which is a fancy way of saying "when we write `P → Q → R`, we mean `P → (Q → R)`."
Mathematicians use right associativity as a convention for powers: if
a mathematician says $10^{10^{10}}$ they don't mean $(10^{10})^{10}=10^{100}$, they
mean $10^{(10^{10})}$. So `10 ^ 10 ^ 10` in Lean means `10 ^ (10 ^ 10)` and not `(10 ^ 10) ^ 10`.
However they use left associativity as a convention for subtraction: if
a mathematician writes $6 - 2 - 1$ they mean $(6 - 2) - 1$ and not $6 - (2 - 1)$.

## Pro tip

`intros p q,` is the same as `intro p, intro q,`.
-/


import tactic.basic
import data.set.basic

namespace set

variables {α : Type*} {β : Type*}

lemma union_of_sub (s: set α) (f : α → set α) (hf : ∀ x ∈ s, x ∈ f x ∧ f x ⊆ s) :
     s = ⋃₀ (f '' s) :=
begin
    ext,
    split,
    simp at *,
    {
        intros xs,
        exact ⟨ x, xs, (hf x xs).1 ⟩
    },
    {
        simp,
        intros x' xs' xfx',
        exact (hf x' xs').2 xfx',
    }
end

lemma preimage_nonempty_of_inter_range {s : set β} (f : α → β) :
    (s ∩ range f).nonempty → (f⁻¹' s).nonempty :=
begin
    intros hi,
    cases hi with b hb,
    have : b ∈ range f := mem_of_mem_inter_right hb,
    cases mem_range.mp this with a ha,
    have : f a ∈ s := mem_of_eq_of_mem ha (mem_of_mem_inter_left hb),
    exact ⟨ a,  mem_preimage.mpr this⟩,
end

lemma nonempty_inter_iff_nonempty {s t : set α} :
    (s ∩ t).nonempty → s.nonempty ∧ t.nonempty :=
begin
    intros h,
    cases h with a ha,
    have h1: a ∈ s := mem_of_mem_inter_left ha,
    have h2: a ∈ t := mem_of_mem_inter_right ha,
    exact ⟨ ⟨ a, h1 ⟩ , ⟨ a, h2 ⟩ ⟩ ,
end

lemma inter_of_subtype (s t: set α) : t ∩ s = subtype.val '' {a : ↥s | ↑a ∈ t} :=
begin
    ext,
    simp at *,
    split,
    {
        intros h,
        exact ⟨ h.2, h.1 ⟩ ,
    },
    {
        rintros ⟨yins, yint ⟩,
        exact ⟨ yint, yins ⟩,
    }
end

end set


/-
This in-class exercise requires solutions to two problems
-/

/-
PROBLEM #1.

In Lean, define pf1 to be a proof of the proposition
that, "for any proposition, Q, (Q ∧ ¬ Q) → false.

Here is a start on an answer. We use λ to
introduce the assumption that Q is some proposition.
The underscore is what you have to fill in.

If you need hints, continue reading the comment
below. Once you're done with this problem, move
onto the second problem in this quiz
-/

theorem pf1 : ∀ Q : Prop, ¬ (Q ∧ ¬ Q)  :=
    λ (Q : Prop),
        ( _ )

/-
Hint #1: Remember that, assuming that A is any
proposition, ¬ A simply means (A → false).

Hint #2: Hover your mouse cursor over the underscore
in the preceding code. You will see that what you
need to replace  it is a proof of (Q ∧ ¬ Q) → false.
Lean writes this as ¬ (Q ∧ ¬ Q), but as you know,
the two expressions are equivalent.

Hint #3: (Q ∧ ¬ Q) → false is an implication.
Remember what a proof of an implication looks like.
Use a corresponding expression in place of the _.

Hint #4: Remember your elimination rules for ∧ (and).

Hint #5: Remember again: ¬ Q  means (Q → false).
If you have a proof of Q → false, then you have
a function that if it is given an assumed proof
of Q it reduces to a proof of false. Look for a
way to give this function a proof of Q!
-/

/-
PROBLEM #2.

Produce a proof, pf2, of the proposition, that
for any propositions, P and Q, (P ∧ Q) ∧ (P ∧ ¬ Q)
→ false. You can use the partial solution that we
gave for the last problem as a model. You'll have
to change the name, pf1, the proposition to be
proved, and the lambda expressions to at least
take (P Q : Prop) as an argument. Your code goes
below. Hint: Remember your and elimination rules.
Also, for this problme, you might want, but are
not required, to use a tactic script.
-/


import data.pnat.prime
import tactic.linarith
open nat
/-
This code outlines formalizes the proofs in Chapter 1 of Hardy and Wright's "An Introduction to the Theory of Numbers".
Where availible, the theorems are proven using tools directly availible in mathlib.
-/

/-
Theorem 1: Every positive integer, except 1, is a product of primes.
-/
theorem product_of_primes {n : ℕ} (hn : nat.prime n) : n.factors = [n] :=
begin
  exact nat.factors_prime hn,
end

/-
Theorem 2: (The Fundamental Theorem of Arithmetic) The standard form of n is unique;
apart from rearrangement of factors, n can be expressed as a product of primes in only
one way.
-/
theorem fundamental_theorem_aritihmetic {n : ℕ} {l : list ℕ} (h₁ : l.prod = n) (h₂ : ∀ (p : ℕ), p ∈ l → nat.prime p)  : l ~ n.factors :=
begin
  exact nat.factors_unique h₁ h₂,
end

/-
Theorem 3: (Euclid's First Theorem) If p is prime, and p|ab, then p|a or p|b.
-/
theorem euclid_first {p a b : ℕ} (q : nat.prime p) : p ∣ a * b → p ∣ a ∨ p ∣ b :=
begin
  exact (nat.prime.dvd_mul q).mp,
end

/-
Theorem 4: (Euclid's Second Theorem) The number of primes is infinite.
-/
theorem euclid_second : ∀ N, ∃ p ≥ N, prime p :=
begin
  intro N,

  let M := factorial N + 1,
  let p := min_fac M,

  have pp : prime p :=
  begin
    refine min_fac_prime _,
    have : factorial N > 0 := factorial_pos N,
    linarith,
  end,

  use p,
  split,
  {
  by_contradiction,
  have h1 : p ∣ factorial N + 1 := min_fac_dvd M,
  have h2 : p ∣ factorial N :=
  begin
     refine pp.dvd_factorial.mpr _,
     exact le_of_not_ge h,
   end,
  have h : p ∣ 1 := (nat.dvd_add_right h2).mp h1,
  exact prime.not_dvd_one pp h,
  },
  {
  exact pp,
  },
end -- This proof follows from the Lean Prover Demo (https://youtu.be/b59fpAJ8Mfs)

/-
Theorem 5: There are blocks of consecutive composite numbers whose length exceeds any given number N.

  This theorem is stated without proof in Chapter 1.

Theorem 6: (The Prime Number Theorem) The number of primes not exceeding x is asymptotic to x/log(x).

  This theorem is stated without proof in Chapter 1. We formalize the proof in Chapter 22.

Theorem 7: (Tchebychef's Theorem) The order of magnitude of n(x) is x/log(x).

  This theorem is stated without proof in Chapter 1.

Theorem 8: p_n is asymptotic to n log(n).

  This theorem is stated without proof in Chapter 1.

Theorem 9: The order of magnitude of p_n is n log(n).

  This theorem is stated without proof in Chapter 1.
-/


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

/-!
# The golden ratio and its conjugate

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

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

noncomputable theory

/-- The golden ratio `φ := (1 + √5)/2`. -/
@[reducible] def golden_ratio := (1 + real.sqrt 5)/2

/-- The conjugate of the golden ratio `ψ := (1 - √5)/2`. -/
@[reducible] def golden_conj := (1 - real.sqrt 5)/2

localized "notation `φ` := golden_ratio" in real
localized "notation `ψ` := golden_conj" in real

/-- The inverse of the golden ratio is the opposite of its conjugate. -/
lemma inv_gold : φ⁻¹ = -ψ :=
begin
  have : 1 + real.sqrt 5 ≠ 0,
    from ne_of_gt (add_pos (by norm_num) $ real.sqrt_pos.mpr (by norm_num)),
  field_simp [sub_mul, mul_add],
  norm_num
end

/-- The opposite of the golden ratio is the inverse of its conjugate. -/
lemma inv_gold_conj : ψ⁻¹ = -φ :=
begin
  rw [inv_eq_iff_inv_eq, ← neg_inv, neg_eq_iff_neg_eq],
  exact inv_gold.symm,
end

@[simp] lemma gold_mul_gold_conj : φ * ψ = -1 :=
by {field_simp, rw ← sq_sub_sq, norm_num}

@[simp] lemma gold_conj_mul_gold : ψ * φ = -1 :=
by {rw mul_comm, exact gold_mul_gold_conj}

@[simp] lemma gold_add_gold_conj : φ + ψ = 1 := by {rw [golden_ratio, golden_conj], ring}

lemma one_sub_gold_conj : 1 - φ = ψ := by linarith [gold_add_gold_conj]

lemma one_sub_gold : 1 - ψ = φ := by linarith [gold_add_gold_conj]

@[simp] lemma gold_sub_gold_conj : φ - ψ = real.sqrt 5 := by {rw [golden_ratio, golden_conj], ring}

@[simp] lemma gold_sq : φ^2 = φ + 1 :=
begin
  rw [golden_ratio, ←sub_eq_zero],
  ring_exp,
  rw real.sq_sqrt; norm_num,
end

@[simp] lemma gold_conj_sq : ψ^2 = ψ + 1 :=
begin
  rw [golden_conj, ←sub_eq_zero],
  ring_exp,
  rw real.sq_sqrt; norm_num,
end

lemma gold_pos : 0 < φ :=
mul_pos (by apply add_pos; norm_num) $ inv_pos.2 zero_lt_two

lemma gold_ne_zero : φ ≠ 0 := ne_of_gt gold_pos

lemma one_lt_gold : 1 < φ :=
begin
  refine lt_of_mul_lt_mul_left _ (le_of_lt gold_pos),
  simp [← sq, gold_pos, zero_lt_one]
end

lemma gold_conj_neg : ψ < 0 := by linarith [one_sub_gold_conj, one_lt_gold]

lemma gold_conj_ne_zero : ψ ≠ 0 := ne_of_lt gold_conj_neg

lemma neg_one_lt_gold_conj : -1 < ψ :=
begin
  rw [neg_lt, ← inv_gold],
  exact inv_lt_one one_lt_gold,
end

/-!
## Irrationality
-/

/-- The golden ratio is irrational. -/
theorem gold_irrational : irrational φ :=
begin
  have := nat.prime.irrational_sqrt (show nat.prime 5, by norm_num),
  have := this.rat_add 1,
  have := this.rat_mul (show (0.5 : ℚ) ≠ 0, by norm_num),
  convert this,
  field_simp
end

/-- The conjugate of the golden ratio is irrational. -/
theorem gold_conj_irrational : irrational ψ :=
begin
  have := nat.prime.irrational_sqrt (show nat.prime 5, by norm_num),
  have := this.rat_sub 1,
  have := this.rat_mul (show (0.5 : ℚ) ≠ 0, by norm_num),
  convert this,
  field_simp
end

/-!
## Links with Fibonacci sequence
-/

section fibrec

variables {α : Type*} [comm_semiring α]

/-- The recurrence relation satisfied by the Fibonacci sequence. -/
def fib_rec : linear_recurrence α :=
{ order := 2,
  coeffs := ![1, 1]}

section poly

open polynomial

/-- The characteristic polynomial of `fib_rec` is `X² - (X + 1)`. -/
lemma fib_rec_char_poly_eq {β : Type*} [comm_ring β] :
  fib_rec.char_poly = X^2 - (X + (1 : polynomial β)) :=
begin
  rw [fib_rec, linear_recurrence.char_poly],
  simp [finset.sum_fin_eq_sum_range, finset.sum_range_succ', monomial_eq_smul_X]
end

end poly

/-- As expected, the Fibonacci sequence is a solution of `fib_rec`. -/
lemma fib_is_sol_fib_rec : fib_rec.is_solution (λ x, x.fib : ℕ → α) :=
begin
  rw fib_rec,
  intros n,
  simp only,
  rw [nat.fib_add_two, add_comm],
  simp [finset.sum_fin_eq_sum_range, finset.sum_range_succ'],
end

/-- The geometric sequence `λ n, φ^n` is a solution of `fib_rec`. -/
lemma geom_gold_is_sol_fib_rec : fib_rec.is_solution (pow φ) :=
begin
  rw [fib_rec.geom_sol_iff_root_char_poly, fib_rec_char_poly_eq],
  simp [sub_eq_zero]
end

/-- The geometric sequence `λ n, ψ^n` is a solution of `fib_rec`. -/
lemma geom_gold_conj_is_sol_fib_rec : fib_rec.is_solution (pow ψ) :=
begin
  rw [fib_rec.geom_sol_iff_root_char_poly, fib_rec_char_poly_eq],
  simp [sub_eq_zero]
end

end fibrec

/-- Binet's formula as a function equality. -/
theorem real.coe_fib_eq' : (λ n, nat.fib n : ℕ → ℝ) = λ n, (φ^n - ψ^n) / real.sqrt 5 :=
begin
  rw fib_rec.sol_eq_of_eq_init,
  { intros i hi,
    fin_cases hi,
    { simp },
    { simp only [golden_ratio, golden_conj], ring_exp, rw mul_inv_cancel; norm_num } },
  { exact fib_is_sol_fib_rec },
  { ring_nf,
    exact (@fib_rec ℝ _).sol_space.sub_mem
            (submodule.smul_mem fib_rec.sol_space (real.sqrt 5)⁻¹ geom_gold_is_sol_fib_rec)
            (submodule.smul_mem fib_rec.sol_space (real.sqrt 5)⁻¹ geom_gold_conj_is_sol_fib_rec) }
end

/-- Binet's formula as a dependent equality. -/
theorem real.coe_fib_eq : ∀ n, (nat.fib n : ℝ) = (φ^n - ψ^n) / real.sqrt 5 :=
by rw [← function.funext_iff, real.coe_fib_eq']


-- Math 52: Week 3

definition is_even (n : ℤ) := ∃ (k : ℤ), n = 2 * k

definition is_odd (n : ℤ) := ∃ (k : ℤ), n = 2 * k + 1

-- Lakins 1.2.4: For every integer n, 4*n+7 is odd.
theorem L124 : ∀ (n : ℤ), is_odd (4*n+7) :=
begin
intro n,
unfold is_odd,
existsi (2*n+3:ℤ),
symmetry,
calc 2*(2*n+3) + 1
= (2*(2*n) + 2*3) + 1 : by rw mul_add ...
= 2*(2*n) + (2*3 + 1) : by rw add_assoc ...
= (2*2)*n + (2*3 + 1) : by rw mul_assoc ...
= 4*n + 7 : by refl,
end
-- Proof: Let n be a given integer. By definition of odd,
-- we want to show that there is an integer k such that
-- 4*n+7 = 2*k+1. Take k = 2*n+3, then:
--   2*k+1 = 2*(2*n+3)+1 = 4*n+7,
-- as required. □

-- Lakins 1.2.1(a) : For every integer n, if n is even then n² is even.
theorem L121a : ∀ (n : ℤ), is_even n → is_even (n * n) :=
begin
sorry
end

-- Lakins 1.2.3(a): For all integers m and n, if m is even then m*n is even.
theorem L123a : ∀ (m n : ℤ), is_even m → is_even (m * n) :=
begin
sorry
end

-- Lakins 1.2.2(a) : For all integers m and n, if m and n are even then m+n is even.
theorem L122a : ∀ (m n : ℤ), is_even m ∧ is_even n → is_even (m + n) :=
begin
sorry
end

-- Lakins 1.2.2(b) : For all integers m and n, if m and n are odd then m+n is even.
theorem L122b : ∀ (m n : ℤ), is_odd m ∧ is_odd n → is_even (m + n) :=
begin
sorry
end


/-
Alice is looking at Bob. Bob is looking at Charlie.
Alice is married. Charlie is not.

Theorem to Prove: Some (∃) married person is looking at some unmarried person

(A) Yes
(B) No
(C) Cannot be determined
(D) It depends
-/

example : ∀ (P : Prop), P ∨ ¬P :=
begin
  assume P,
  apply or.inr _,
  intro p,
  _
end

/-
In constructive logic, ∀ (P : Prop), P ∨ ¬ P,
is not provable.
-/

axioms
(Person : Type)
(Married : Person → Prop)
(LookingAt : Person → Person → Prop)
(alice bob charlie : Person)
(alab : LookingAt alice bob)
(blac : LookingAt bob charlie)
(am : Married alice)
(ncm : ¬Married charlie)

example : _ : _

/-
forall p1 p2, Married p1 and not married p2 and looking at p1 p2
-/

example : ∀ (p1 p2 : Person),
    Married p1 → ¬ Married p2 → LookingAt p1 p2 := _

/-
Every married person is looking at every unmarried person.
This is not quite the right formalization.
-/

/-
Some married person, p1, is looking at some unmarried person, p2.
This is the formalization that we want. Now the question is, can
we prove it?
-/
example : ∃ (p1 : Person), ∃ (p2 : Person), Married p1 ∧ ¬Married p2 ∧ LookingAt p1 p2 :=
begin
apply exists.intro alice,
apply exists.intro bob,
split,
apply am,
split,
end

-- STUCK!

example : ∃ (p1 : Person), ∃ (p2 : Person), Married p1 ∧ ¬Married p2 ∧ LookingAt p1 p2 :=
begin
apply exists.intro bob,
apply exists.intro charlie,
split,
end

-- STUCK

/-
In constructive logic, we don't know that it's true
that Bob is married or Bob is not married, whereas
in classical reasoning that would always be true,
even if we don't know which case holds.

In constructive logic, for any proposition, P, there
are three possibilities:

(1) We have a proof of P
(2) We have a proof of ¬P
(3) We don't have a proof either way! This is the "MIDDLE!"

In computer science and mathematics, there are plenty of
examples where we don't know which case holds.
  - polynomial time (P) = non-deterministic polynomial time (NP)? TSP, Boolean SAT
  - Collatz conjecture -- hailstone program terminates on all inputs
-/

/-
meta def HS (n : nat) :=
if (n = 1 ∨ n = 0) return 0
else (if n%2 = 0) (HS n/2)
else (if n%2 = 1) (HS n*3+1)

Does this function terminate for all inputs n?

5 -> 8 -> 4 -> 2 -> 1 .
7 -> 22 -> 11 -> 34 -> 17 -> 51 -> 154 -> 77 -> ...
-/

/-
One might believe that constructive logic is weaker
than classical logic in the sense that there are
propositions that are provable in the latter but
not in the former. On the other hand, we can always
reason classically in constructive logic by simply
introducing the "law of the excluded middle" as an
axiom. What it says is that for any proposition, P,
whatsoever, P ∨ ¬P is true in the sense that we can
assume that we have a proof of it. The trick is then
to do case analysis on such a *proof object*.
-/
axiom em : ∀ (P : Prop), P ∨ ¬ P

example : ∃ (p1 : Person), ∃ (p2 : Person), Married p1 ∧ ¬Married p2 ∧ LookingAt p1 p2 :=
begin
  cases (/-proof of (bim or bnm)-/ em (Married bob)), --!!!
  -- Married bob
  apply exists.intro bob,
  apply exists.intro charlie,
  split,
  assumption,
  split,
  exact ncm,
  exact blac,
  apply exists.intro alice,
  apply exists.intro bob,
  split,
  exact am,
  split,
  assumption,
  exact alab,
end

-- Yay

/-
The axiom of the excluded middle is defined in the Lean library.
You can always apply it, but in general you will want to think
about the tradeoffs that are involved. Among the losses are (1)
you will no longer have any *evidence* for which case is true,
(2) you will be unable to extract runnable code from a proof of
a disjunction, because such a proof is just made from thin air:
it contains no proof/evidence either way but only says that one
of them must be true.
-/
#check classical.em

theorem neg_elim : ∀ (P : Prop), ¬¬P → P :=
begin
  assume P h,
  /-
  (¬ P -> false)
  ((P → false) → false)
  P?
  -/
  have ponp := classical.em P,
  cases ponp,
  assumption,
  contradiction,
end

/-
DeMorgan's laws
¬ (P ∧ Q) ↔ (¬P ∨ ¬Q)
¬ (P ∨ Q) ↔ (¬P ∧ ¬Q)
-/

theorem dm1 : ∀ (P Q : Prop), ¬(P ∧ Q) ↔ (¬P ∨ ¬Q) :=
begin
  intros,
  split,
  -- forward
  assume h,
  -- have: P ∧ Q → false

end

theorem dm2 : ∀ (P Q : Prop), ¬ (P ∨ Q) ↔ (¬P ∧ ¬Q) :=
begin
end


-- Subgrupos
-- =====================================================================

-- ---------------------------------------------------------------------
-- Ejercicio. Importar la teoría de grupos de la sesión anterior.
-- ---------------------------------------------------------------------

import .Grupos

-- ---------------------------------------------------------------------
-- Ejercicio. Abrir el espacio de nombre `oculto`.
-- ---------------------------------------------------------------------

namespace oculto

-- ---------------------------------------------------------------------
-- Ejercicio. Un subgrupo de un grupo G es un subconjunto de G que
-- contiene al elemento neutro y es cerrado por la multiplicación y el
-- inverso. Definir la estructura `subgroup` tal que `subgroup G` es el
-- tipo de los subgrupos de G.
-- ---------------------------------------------------------------------

structure subgroup (G : Type) [group G] :=
(carrier : set G)
(one_mem' : (1 : G) ∈ carrier)
(mul_mem' {x y} : x ∈ carrier → y ∈ carrier → x * y ∈ carrier)
(inv_mem' {x} : x ∈ carrier → x⁻¹ ∈ carrier)

/-

Pdte. Traducir carrier por elementos.
Pdte. Usar notación funcional en lugar de la de punto.

At this point, here's what we have.

A term `H` of type `subgroup G`, written `H : subgroup G`, is a
*quadruple*. To give a term `H : subgroup G` is to give the following four things:
1) `H.carrier`  (a subset of `G`),
2) `H.one_mem'` (a proof that `1 ∈ H.carrier`),
3) `H.mul_mem'` (a proof that `H` is closed under multiplication)
4) `H.inv_mem'` (a proof that `H` is closed under inverses).

Note in particular that Lean, being super-pedantic, *distinguishes* between
the subgroup `H` and the subset `H.carrier`. One is a subgroup, one is
a subset. When we get going we will start by setting up some infrastructure
so that this difference will be hard to notice.

Note also that if `x` is in the subgroup `H` of `H` then the _type_ of `x` is still `G`,
and `x ∈ carrier` is a Proposition. Note also that `x : carrier` doesn't
make sense (`carrier` is a term, not a type, rather counterintuitively).

-/

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

namespace subgroup

-- ---------------------------------------------------------------------
-- Ejercicio. Abrir el espacio de nombres `oculto.group`
-- ---------------------------------------------------------------------

open oculto.group

-- ---------------------------------------------------------------------
-- Ejercicio. Definir las siguientes variables
-- + G para grupos y
-- + H, J y K para subgrupos de G.
-- ---------------------------------------------------------------------

variables {G : Type} [group G]
variables (H J K : subgroup G)

-- La notación `h ∈ H.carrier` no es correcta. Además, no quiero
-- escribir "H.carrier" en todas partes; lo que quiero es poder
-- identificar el subgrupo `H` con el conjunto de sus elementos
-- (`H.carrier`).
--
-- Hay que tener en cuenta que estas cosas no son iguales, en primer
-- lugar porque `H` contiene la prueba de que `H.carrier` es un
-- subgrupo, y en segundo lugar, porque tienen diferentes tipos: `H`
-- tiene el tipo `supgroup G` y `H.carrier` tiene el tipo `set G`.

-- ---------------------------------------------------------------------
-- Ejercicio. Sean `x : G` y `H : subgroup G`. Definir la notación
-- `x ∈ H` para denotar `x ∈ H.carrier`.
-- ---------------------------------------------------------------------

instance : has_mem G (subgroup G) := ⟨λ y H, y ∈ H.carrier⟩

-- ---------------------------------------------------------------------
-- Ejercicio. Sean `x : G` y `H : subgroup G`. Definir la notación
-- `↑H` para denotar `H.carrier`.
-- ---------------------------------------------------------------------

instance : has_coe (subgroup G) (set G) := ⟨λ H, H.carrier⟩

-- ---------------------------------------------------------------------
-- Ejercicio. Sea `g : G`. Demostrar que
--    g ∈ H.carrier ↔ g ∈ H
-- ---------------------------------------------------------------------

@[simp] lemma mem_carrier
  {g : G}
  : g ∈ H.carrier ↔ g ∈ H :=
by refl

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que `g` está en `H` considerado como un
-- subconjunto de `G` syss` g` está en `H` considerado como subgrupo de
-- `G`.
-- ---------------------------------------------------------------------

@[simp] lemma mem_coe
  {g : G}
  : g ∈ (↑H : set G) ↔ g ∈ H :=
by refl

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que
--    1 ∈ H
-- ---------------------------------------------------------------------

theorem one_mem :
  (1 : G) ∈ H :=
one_mem' H

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que los subgrupos son cerrados respecto de las
-- multiplicaciones.
-- ---------------------------------------------------------------------

theorem mul_mem
  {x y : G}
  : x ∈ H → y ∈ H → x * y ∈ H :=
mul_mem' H

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que los subgrupos son cerrados respecto de los
-- inversos.
-- ---------------------------------------------------------------------

theorem inv_mem {x : G} : x ∈ H → x⁻¹ ∈ H :=
inv_mem' H

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que
--    x⁻¹ ∈ H ↔ x ∈ H
-- ---------------------------------------------------------------------

@[simp] theorem inv_mem_iff
  {x : G}
  : x⁻¹ ∈ H ↔ x ∈ H :=
begin
  split,
  { intro h,
    rw ← oculto.group.inv_inv x,
    exact inv_mem H h, },
  { exact inv_mem H, },
end

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que si `x` y `xy` están en `H`, entonces `y`
-- también lo está.
-- ---------------------------------------------------------------------

-- 1ª demostración
example
  {x y : G}
  (hx : x ∈ H)
  (hxy : x * y ∈ H)
  : y ∈ H :=
begin
  replace hx : x⁻¹ ∈ H := inv_mem H hx,
  have hy : x⁻¹ * (x * y) ∈ H := mul_mem H hx hxy,
  simp at hy,
  exact hy,
end

-- 2ª demostración
theorem mem_of_mem_mul_mem
  {x y : G}
  (hx : x ∈ H)
  (hxy : x * y ∈ H)
  : y ∈ H :=
begin
  rw ← inv_mem_iff at hx,
  convert mul_mem H hx hxy,
  simp,
end

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que si dos subgrupos de G tienen los mismos
-- elementos, entonces son iguales.
-- ---------------------------------------------------------------------

-- 1ª demostración
example
  {H K : subgroup G}
  (h : H.carrier = K.carrier)
  : H = K :=
begin
  cases H,
  cases K,
  simp at h,
  simp,
  exact h,
end

-- 2ª demostración
theorem ext'
  {H K : subgroup G}
  (h : H.carrier = K.carrier)
  : H = K :=
begin
  cases H,
  cases K,
  simp * at *,
end

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que dos subgrupos son iguales syss tienen los
-- mismos elementos.
-- ---------------------------------------------------------------------

theorem ext'_iff
  {H K : subgroup G}
  : H.carrier = K.carrier ↔ H = K :=
begin
  split,
  { exact ext', },
  { intro h,
    rw h, }
end

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que si dos subgrupos tienen los mismos
-- elementos, entonces son iguales.
-- ---------------------------------------------------------------------

@[ext] theorem ext
  {H K : subgroup G}
  (h : ∀ x, x ∈ H ↔ x ∈ K)
  : H = K :=
begin
  apply ext',
  ext,
  apply h,
end

-- Etiquetamos ese teorema con `ext` para que la táctica `ext` funcione
-- en subgrupos; es decir, para demostrar que dos subgrupos son iguales
-- se puede usar la táctica `ext` para reducirlo a demostrar que tienen
-- los mismos elementos.

-- =====================================================================
-- § La estructura de retículo de subgrupos                           --
-- =====================================================================

-- Los subgrupos de un grupo forman lo que se conoce como un retículo;
-- es decir, es un conjunto parcialmente ordenado con una las funciones
-- max y min.
--
-- Se ordenan parcialmente los subgrupos diciendo `H ≤ K` si
-- `H.carrier ⊆ K.carrier`.
--
-- Los subgrupos incluso tienen las funciones Sup e Inf (el Inf de de
-- los subgrupos de un grupo es su intersección; su Sup es el subgrupo
-- generado por su unión).
--
-- Esta estructura (un conjunto parcialmente ordenado con Sup e Inf) se
-- denomina "retículo completo", y Lean tiene esta estructura
-- definida
--
-- Nosotros construiremos una estructura de retículo completo en los
-- subgrupos del grupo G. Comenzamos por definiendo una relación ≤ sobre
-- el tipo de los subgrupos de un grupo: Decimos `H ≤ K` si
-- `H.carrier ⊆ K.carrier`.

-- ---------------------------------------------------------------------
-- Ejercicio. Definir la relación ≤ sobre el tipo de los subgrupos del
-- grupo G de forma que `H ≤ K` si `H.carrier ⊆ K.carrier`.
-- ---------------------------------------------------------------------

instance : has_le (subgroup G) := ⟨λ H K, H.carrier ⊆ K.carrier⟩

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que
--    H ≤ K ↔ H.carrier ⊆ K.carrier
-- ---------------------------------------------------------------------

lemma le_def :
  H ≤ K ↔ H.carrier ⊆ K.carrier :=
by refl

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que
--    H ≤ K ↔ ∀ g, g ∈ H → g ∈ K
-- ---------------------------------------------------------------------

lemma le_iff :
  H ≤ K ↔ ∀ g, g ∈ H → g ∈ K :=
by refl

-- Nota: En los siguientes ejercicios se demostrará que ≤ es un orden
-- parcial.

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que
--    H ≤ H
-- ---------------------------------------------------------------------

@[refl] lemma le_refl :
  H ≤ H :=
by rw le_def

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que
--    H ≤ K → K ≤ H → H = K
-- ---------------------------------------------------------------------

lemma le_antisymm :
  H ≤ K → K ≤ H → H = K :=
begin
  rw [le_def, le_def, ← ext'_iff],
  exact set.subset.antisymm,
end

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que
--    H ≤ J → J ≤ K → H ≤ K
-- ---------------------------------------------------------------------

@[trans] lemma le_trans :
  H ≤ J → J ≤ K → H ≤ K :=
begin
  rw [le_def, le_def, le_def],
  exact set.subset.trans,
end

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que los subgrupos de G con la relación ≤ es un
-- orden parcial.
-- ---------------------------------------------------------------------

instance : partial_order (subgroup G) :=
{ le          := (≤),
  le_refl     := le_refl,
  le_antisymm := le_antisymm,
  le_trans    := le_trans }

-- =====================================================================
-- § Intersecciones                                                   --
-- =====================================================================

-- Demostremos que la intersección de dos subgrupos es un subgrupo. En
-- Lean esta es su definición: dados dos subgrupos, definimos un nuevo
-- subgrupo cuyo subconjunto subyacente es la intersección de los
-- subconjuntos, y luego probamos los axiomas.

-- ---------------------------------------------------------------------
-- Ejercicio. Definir la función
--    inf : subgroup G → subgroup G → subgroup G
-- tal que (inf H K) es el subgrupo intersección de H y de K.
-- ---------------------------------------------------------------------

-- 1ª solución
def inf (H K : subgroup G) : subgroup G :=
{ carrier := H.carrier ∩ K.carrier,
  one_mem' :=
    begin
      split,
      { exact one_mem H, },
      { exact one_mem K, },
    end,
  mul_mem' :=
    begin
      intros x y hx hy,
      cases hx with hxH hxK,
      cases hy with hyH hyK,
      split,
      { exact mul_mem H hxH hyH },
      { exact mul_mem K hxK hyK },
    end,
  inv_mem' :=
    begin
      rintro x ⟨hxH, hxK⟩,
      exact ⟨inv_mem H hxH, inv_mem K hxK⟩,
    end }

-- 2ª solución
def inf_term_mode (H K : subgroup G) : subgroup G :=
{ carrier  := carrier H ∩ carrier K,
  one_mem' := ⟨one_mem H,
               one_mem K⟩,
  mul_mem' := λ _ _ ⟨hhx, hkx⟩ ⟨hhy, hky⟩,
              ⟨mul_mem H hhx hhy,
               mul_mem K hkx hky⟩,
  inv_mem' := λ x ⟨hhx, hhy⟩,
              ⟨inv_mem H hhx,
               inv_mem K hhy⟩}

-- ---------------------------------------------------------------------
-- Ejercicio. Asignar el símbolo ⊓ a la operación inf.
-- ---------------------------------------------------------------------

instance : has_inf (subgroup G) := ⟨inf⟩

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que el conjunto subyacente de la intersección de
-- dos subgrupos es la intersección de los conjuntos subyacentes.
-- ---------------------------------------------------------------------

lemma inf_def
  (H K : subgroup G)
  : (H ⊓ K : set G) = (H : set G) ∩ K :=
by refl

-- =====================================================================
-- § Subgrupo generado por un subconjunto                             --
-- =====================================================================

-- Definir el sup de dos subgrupos es más difícil, porque no solo
-- tomamos la unión, tenemos que mirar el subgrupo generado por esta
-- unión. Así que necesitamos definir el subgrupo de `G` generado por un
-- subconjunto `S: set G`. Hay dos formas completamente diferentes de
-- hacer esto. La primera es "de arriba hacia abajo" (podríamos definir
-- el subgrupo generado por `S` como la intersección de todos los
-- subgrupos de `G` que contienen a `S`. La segunda es "de abajo hacia
-- arriba" (podríamos definir el subgrupo generado por `S` por inducción
-- diciendo que `S` está en el subgrupo, 1 está en el subgrupo, el
-- producto de dos cosas en el subgrupo está en el subgrupo, el inverso
-- de algo en el subgrupo está en el subgrupo, y eso es todo). Ambos
-- métodos funcionan bastante bien en Lean. Vamos a utilizar el primero.

-- ---------------------------------------------------------------------
-- Ejercicio. Abrir el espacio de nombres `set`.
-- ---------------------------------------------------------------------

open set

/-

Here is the API for `set.bInter` (or `bInter`, as we can now call it):

Notation: `⋂` (type with `\I`)

If `X : set (subgroup G)`, i.e. if `X` is a set of subgroups of `G`, then

`⋂ K ∈ X, (K : set G)` means "take the intersection of the underlying subsets".

-- mem_bInter_iff says you're in the intersection iff you're in
-- all the things you're intersecting. Very useful for rewriting.
`mem_bInter_iff : (g ∈ ⋂ (K ∈ S), f K) ↔ (∀ K, K ∈ s → g ∈ f K)`

-- mem_bInter is just the one way implication. Very useful for `apply`ing.
`mem_bInter : (∀ K, K ∈ s → g ∈ f K) → (g ∈ ⋂ (K ∈ S), f K)`

-/
/-
We will consider the closure of a set as the intersect of all subgroups
containing the set
-/

#check mem_bInter_iff
#check mem_bInter

-- Se usarán las siguientes propiedades de la intersección de familias
-- de conjuntos: Sean s : set α, t : α → set β, y : β. Entonces
--    mem_bInter_iff : y ∈ (⋂ x ∈ s, t x) ↔ ∀ x ∈ s, y ∈ t x
--    mem_bInter     : (∀ x ∈ s, y ∈ t x) → y ∈ ⋂ x ∈ s, t x

-- ---------------------------------------------------------------------
-- Ejercicio. Definir la función
--    Inf : set (subgroup G) → subgroup G
-- tal que (Inf X) es la intersección de conjunto X de sugrupos de G.
-- ---------------------------------------------------------------------

-- 1ª solución:
def Inf (X : set (subgroup G)) : subgroup G :=
{ carrier := ⋂ K ∈ X, (K : set G),
  one_mem' :=
    begin
      apply mem_bInter,
      intros H hH,
      apply one_mem H,
    end,
  mul_mem' :=
    begin
      intros x y hx hy,
      rw mem_bInter_iff at *,
      intros H hH,
      apply mul_mem H,
      { apply hx,
        exact hH },
      { exact hy H hH }
    end,
  inv_mem' :=
    begin
      intros x hX,
      rw mem_bInter_iff at *,
      intros H hH,
      exact inv_mem H (hX H hH),
    end,
}

-- 2ª solución
def Inf' (X : set (subgroup G)) : subgroup G :=
{ carrier  := ⋂ t ∈ X, (t : set G),
  one_mem' := mem_bInter (λ i h, one_mem i),
  mul_mem' := λ x y hx hy,
              mem_bInter (λ i h, mul_mem i (by apply mem_bInter_iff.1 hx i h)
                                           (by apply mem_bInter_iff.1 hy i h)),
  inv_mem' := λ x hx,
              mem_bInter (λ i h, inv_mem i (by apply mem_bInter_iff.1 hx i h)) }

-- ---------------------------------------------------------------------
-- Ejercicio. Definir la función
--    closure : set G → subgroup G
-- tal que (closure S) es la clausura de S; es decir, el menor subgrupo
-- de G que contiene a S.
-- ---------------------------------------------------------------------

def closure (S : set G) : subgroup G :=
  Inf {H : subgroup G | S ⊆ H}

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que
--    x ∈ closure S ↔ ∀ H : subgroup G, S ⊆ H → x ∈ H
-- ---------------------------------------------------------------------

lemma mem_closure_iff
  {S : set G}
  {x : G}
  : x ∈ closure S ↔ ∀ H : subgroup G, S ⊆ H → x ∈ H :=
mem_bInter_iff

-- Un operador de clausura en un conjunto S es una función cl del
-- conjunto potencia de S en sí mismo que satisface las siguientes
-- condiciones para todos los subconjuntos X, Y de S:
--    1) X ⊆ cl X
--    2) X ⊆ Y → cl X ⊆ cl Y
--    3) cl (cl X) = cl X
--
-- Vamos a demostrar que closure es un operador de clausura.

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que
--    S ⊆ ↑(closure S)
-- ---------------------------------------------------------------------

-- 1ª demostración
lemma subset_closure
  (S : set G)
  : S ⊆ ↑(closure S) :=
begin
  intro g,
  intro hgS,
  rw [mem_coe, mem_closure_iff],
  intros H hH,
  apply hH,
  exact hgS,
end

-- 2ª demostración
lemma subset_closure'
  (S : set G)
  : S ⊆ closure S :=
λ s hs H ⟨y, hy⟩, by {rw [←hy, mem_Inter], exact λ hS, hS hs}

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que si S ⊆ T, entonces closure S ≤ closure T.
-- ---------------------------------------------------------------------

lemma closure_mono
  {S T : set G}
  (hST : S ⊆ T)
  : closure S ≤ closure T :=
begin
  intros x hx,
  rw [mem_carrier, mem_closure_iff] at *,
  intros H hTH,
  apply hx,
  exact subset.trans hST hTH,
end

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que
--    closure S ≤ H ↔ S ⊆ ↑H
-- ---------------------------------------------------------------------

lemma closure_le
  (S : set G)
  (H : subgroup G)
  : closure S ≤ H ↔ S ⊆ ↑H :=
begin
  split,
  { intro hSH,
    exact subset.trans (subset_closure S) hSH },
  { intros hSH g hg,
    rw [mem_carrier, mem_closure_iff] at hg,
    exact hg _ hSH }
end

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que
--    closure S = closure (closure S)
-- ---------------------------------------------------------------------

lemma closure_closure
  (S : set G)
  : closure S = closure (closure S) :=
begin
  apply le_antisymm,
  { apply subset_closure, },
  { rw closure_le,
    intros x hx,
    exact hx },
end

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que
--    closure ↑H = H
-- ---------------------------------------------------------------------

lemma closure_self
  {H : subgroup G}
  : closure ↑H = H :=
begin
  apply le_antisymm,
  { rw le_iff,
    intro g,
    rw mem_closure_iff,
    intro h,
    apply h,
    refl },
  { exact subset_closure H }
end

-- ---------------------------------------------------------------------
-- Ejercicio. Sean G un grupo, S ⊆ G y p una propiedad sobre
-- G. Demostrar que si
--    ∀ x ∈ S, p x
--    p 1
--    ∀ x y, p x → p y → p (x * y)
--    ∀ x, p x → p x⁻¹
-- entonces
--    ∀ x, x ∈ closure S → p x
-- ---------------------------------------------------------------------

-- 1ª demostración
lemma closure_induction
  {p : G → Prop}
  {S : set G}
  (HS : ∀ x ∈ S, p x)
  (H1 : p 1)
  (Hmul : ∀ x y, p x → p y → p (x * y))
  (Hinv : ∀ x, p x → p x⁻¹)
  : ∀ x, x ∈ closure S → p x :=
begin
  let H : subgroup G :=
  { carrier  := p,
    one_mem' := H1,
    mul_mem' := Hmul,
    inv_mem' := Hinv },
  change closure S ≤ H,
  change S ⊆ ↑H at HS,
  rw closure_le,
  exact HS,
end

-- 2ª demostración
lemma closure_induction'
  {p : G → Prop}
  {S : set G}
  (HS : ∀ x ∈ S, p x)
  (H1 : p 1)
  (Hmul : ∀ x y, p x → p y → p (x * y))
  (Hinv : ∀ x, p x → p x⁻¹)
  : ∀ x, x ∈ closure S → p x :=
λ x h, (@closure_le _ _ _ ⟨p, H1, Hmul, Hinv⟩).2 HS h

-- Una conexión de Galois https://bit.ly/3vfzFSS entre un par de tipos α
-- y β, parcialmente ordenados, es un par de funciones `l : α → β` y
-- `u : β → α` tales que `∀a b, l a ≤ b ↔ a ≤ u b`. Su definición en
-- Lean es
--    def galois_connection [preorder α] [preorder β] (l : α → β) (u : β → α) :=
--      ∀a b, l a ≤ b ↔ a ≤ u b
--
-- A inserción de Galois insertion es una conexión de Galois connection
-- tal que `l ∘ u = id`. También contiene una función de elección. Su
-- definición en Lean es
--    structure galois_insertion {α β : Type*} [preorder α] [preorder β] (l : α → β) (u : β → α) :=
--    (choice : Πx:α, u (l x) ≤ x → β)
--    (gc : galois_connection l u)
--    (le_l_u : ∀x, x ≤ l (u x))
--    (choice_eq : ∀a h, choice a h = l a)

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que `closure : set G → subgroup G` y
-- `coe : subgroup G → set G` forman una conexión de Galois entre los
-- subgrupos de G.
-- ---------------------------------------------------------------------

lemma gc :
  galois_connection (closure : set G → subgroup G) (coe : subgroup G → set G) :=
closure_le

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que `closure : set G → subgroup G` y
-- `coe : subgroup G → set G` forman una inserción de Galois entre los
-- subgrupos de G.
-- ---------------------------------------------------------------------

def gi : galois_insertion (closure : set G → subgroup G) (coe : subgroup G → set G) :=
{ choice := λ S _, closure S,
  gc := gc,
  le_l_u := λ H, subset_closure (H : set G),
  choice_eq := λ _ _, rfl }

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que los subgrupos son un retículo completo.
-- ---------------------------------------------------------------------

instance : complete_lattice (subgroup G) :=
{.. galois_insertion.lift_complete_lattice gi}

end subgroup

end oculto

-- =====================================================================
-- § Referencias                                                      --
-- =====================================================================

-- + Kevin Buzzard. "Formalising mathematics : workshop 2 — groups and
--   subgroups. https://bit.ly/3iaYdqM
-- + Kevin Buzzard. formalising-mathematics: week 2, Part_B_subgroups.lean
--   https://bit.ly/3oWT9ux
-- + Kevin Buzzard. formalising-mathematics: week 2, Part_B_subgroups_solutions.lean
--   https://bit.ly/3iR1z2z


import data.nat.basic
import data.nat.digits

def digits_sum (n : ℕ) : ℕ := (nat.digits 10 n).sum

-- First we prove digits_sum (10n) = digits_sum n
lemma digits_sum_ten_mul {n : ℕ} :
  digits_sum (10 * n) = digits_sum n :=
begin
  have h : 0 = n ∨ 0 < n,
  { apply nat.eq_or_lt_of_le,
    exact nat.zero_le n, },
  destruct h,
  -- Case 1: n = 0
  { intros h0,
    rw ← h0,
    rw nat.mul_zero, },
  -- Case 2: 0 < n
  { intros h0,
    have h : nat.digits 10 (10 * n) = 0 :: nat.digits 10 n,
    { calc nat.digits 10 (10 * n) = nat.digits 10 (0 + 10 * n) : by rw (nat.zero_add (10 * n))
      ... = 0 :: nat.digits 10 n : _,
      { rw nat.digits_add,
        norm_num,
        norm_num,
        right, exact h0, } },
    calc (nat.digits 10 (10 * n)).sum = (0 :: nat.digits 10 n).sum : by rw h
    ... = 0 + (nat.digits 10 n).sum : by rw list.sum_cons
    ... = (nat.digits 10 n).sum : by rw nat.zero_add, }
end

-- And then use the previous lemma and induct on a
-- Lemma name suggestion by Yaël Dillies on the Xena Project Discord
lemma digits_sum_ten_pow_mul {a n : ℕ} :
  digits_sum (10^a * n) = digits_sum n :=
begin
  induction a,
  simp,
  rwa [pow_succ, mul_assoc, digits_sum_ten_mul],
end

theorem osk2002_13 : digits_sum (2^(2002) * 5^(2003)) = 5 :=
begin
  have h : 2^(2002) * 5^(2003) = 10^(2002) * 5,
  { calc 2^(2002) * 5^(2003) = 2^(2002) * 5^(2002 + 1) : _
    ... = 2^(2002) * (5^(2002) * 5^1) : by rw pow_add
    ... = 2^(2002) * 5^(2002) * 5 : by simp [mul_assoc]
    ... = 10^(2002) * 5 : _,
    { simp,
      apply congr_arg,
      norm_num, },
    { rw ← mul_pow,
      simp,
      norm_num, } },
  calc digits_sum (2^(2002) * 5^(2003)) = digits_sum(10^(2002) * 5) : by rw h
  ... = digits_sum(5) : by rw digits_sum_ten_pow_mul
  ... = 5 : by simp [digits_sum],
end


import data.real.basic

def converges_to (s : ℕ → ℝ) (a : ℝ) :=
∀ ε > 0, ∃ N, ∀ n ≥ N, abs (s n - a) < ε

def cauchy_seq (s : ℕ → ℝ) :=
∀ ε > 0, ∃ N, ∀ n m ≥ N, abs (s n - s m) < ε

variables {s t : ℕ → ℝ} {a b c d : ℝ} {z:ℕ }
variable (x : ℕ → ℝ )  := x. + x.2

theorem conv_is_cauchy (h: converges_to s a):
cauchy_seq (λ n , s n) :=
begin
intros ε εpos, --Introduce ε: ℝ and εpos: ε > 0
dsimp, --This makes our goal easier to read
have εpos2 : 0 < ε / 2,
linarith, --This follows from ε > 0
cases h (ε / 2) εpos2 with N₁ h₂, --Using the convergence of s with ε/2
cases h (ε / 2) εpos2 with N₂ h₃, --Using the convergence of s with ε/2
use max N₁ N₂, --We have that  n ≥ max N₁ N₂
intros p q r t, --Introduce the natural numbers p and r which are both greater than max N₁ N₂
have h₄: p ≥ N₁,finish, --This above follows from p ≥ max N₁ N₂
have h₅: r ≥ N₂, finish,
specialize @h₂ p h₄, -- This gives h₂: |s p - a| < ε / 2
specialize @h₃ r h₅, -- This gives h₃: |s r - a| < ε / 2
rw abs_sub_comm (s r) a at h₃, --Rewrite |s r - a| as |a - s r|
have h₆: |s p - a| + |a - s r| < ε/2 +ε/2,
apply add_lt_add h₂ h₃, -- Add h₂ and h₃ together
norm_num at h₆, --ε / 2 + ε / 2 = ε
have h₇: |s p - s r| ≤ |s p - a| + |a - s r|,
exact abs_sub_le (s p) a (s r), --Follows from the triangle inequality
apply lt_of_le_of_lt h₇ h₆, --Inequalities h₇ and h₆ imply the result
end

theorem conv0_cauchy (u : ℕ → ℝ)
(h₁: ∀ (n m :ℕ ) ,   |s n - s m| ≤ u n)
(h₂: converges_to u 0) : cauchy_seq (λ n, s n):=
begin
intros ε εpos, --Introduce ε: ℝ and εpos: ε > 0
dsimp, --This makes our hypothesis easier to read
cases h₂ ε εpos with N h₃, --Convergence of u lets us have N: ℕ and  h₃: ∀ (n : ℕ), n ≥ N → |u n - 0| < ε
use N, -- Our goal is now ∀ (n : ℕ), n ≥ N → ∀ (m : ℕ), m ≥ N → |s n - s m| < ε
intros n ineqn m ineqm, --We have n: ℕ ineqn: n ≥ N m: ℕ and ineqm: m ≥ N
specialize @h₃ n ineqn, --h₃ becomes |u n - 0| < ε
rw sub_zero at h₃, -- |u n - 0| = |u n|
specialize @h₁ n m,-- h₁ now reads as |s n - s m| ≤ u n
have h₄: u n ≤ |u n|,
exact le_abs_self (u n),--This is definitional
apply lt_of_le_of_lt h₁ (lt_of_le_of_lt h₄ h₃),-- h₁ h₄ and h₃ together imply the goal
end


/- *** functons involving nats *** -/

/-
In the field of natural number arithmetic, one
of the fundamental functions is called successor.
In Lean it's nat.succ in Lean. It's the function
that, when applied to any nat, returns its successor,
the next larger nat. For example, the application
expression, (nat.succ 0), means 1, while the term,
nat.succ(nat.succ 0) means 2. (There are some
subtleties that we'll open up later.)
-/

example : nat.succ 0 = 1 := rfl

/-
Question: What is the type of nat.succ? Figure it
out first, then you may check your answer by using
#check.
-/

/- *** syntax options for defining your own funtions *** -/

/-
Firat we'll see how to implement basic Boolean functions,
such as "and." For a value of this type, there are just two
cases: tt and ff (in Lean). Then we'll turn to functions
involving natural numbers, where for any natural number,
there are still just two cases but they are now n = 0 and
n > 0.
-/

/-
We will also use this discussion to present a few different
styles you can use to define functions in Lean. We wil in
particular implement two simple functions using each of three
different syntactic approaches. The functions, sub1, and add2,
respectively, return the predecessor, and the successor of the
successor of their arguments.

- sub1 : ℕ → ℕ
    Given n,
      case analysis:
        when n is 0, return 0,              -- case n = 0
        when n is (nat.succ n'), return n'  -- case n > 0

- add2 : ℕ → ℕ
    Given n,
    return nat.succ(nat.succ n))
-/

/-
First, we'll see how we can define these
functions by declaring their types and then
using *tactic scripts* to produce correct
implementations: values of these function
types that compute and return the correct
results. It feels like you're just proving
a theorem, but now the proof is a program!
that implements your task.
-/
namespace impl_script

/-
To start, we'll declare each function just
as we'd state a logical proposition, then
we'll "prove" they type by providing not
any program of this type but one that also
does what we require. Here we go.
-/

def sub1 : ℕ → ℕ :=
  begin
  -- give argument a name
  assume n,
  -- do case analysis on n (=0, >0)
  cases n with n',
  -- case where n = 0
  exact 0,
  -- case where n = (succ n') > 0
  exact n',
  end

def add2 : ℕ → ℕ :=
  begin
    assume n,   -- bind name to argument
    exact n+2,  -- means exactly nat.succ(nat.succ n)
  end

/-
Next we can show that we can apply these
functions and that they work as expected.
-/
example : sub1 0 = 0 := rfl
example : sub1 1 = 0 := rfl
example : sub1 2 = 1 := rfl
example : sub1 3 = 1 := rfl  -- bad test
example : add2 0 = 2 := rfl
example : add2 1 = 3 := rfl
example : add2 2 = 4 := rfl
example : add2 3 = 6 := rfl -- bad test

end impl_script

/-
Next we'll implement the same functions using
Lean's "pattern matching" or "by cases" syntax.
-/
namespace impl_cases

def sub1 : ℕ → ℕ
  | 0 := 0                -- if arg is 0, then 0
  | (nat.succ n') := n'   -- otherwise one less than arg

/-
Each line starting with | gives a pattern-result
pair. Each line is |, pattern, := result. The really
fundamental idea here is that you can pull apart the
arguments while you're matching to get at value that
they incorporate. Starting from the top, Lean matches
given arguments with each pattern until one matches.
The matching process can bind names to parts of the
arguments. These names can then be used on the right
of the := to define the value of the return result.
-/

/-
The "patterns" that we try to match with the incoming
argument in our examples here correspond to the two
cases, n = 0 and n > 9. These are the only two forms
of a nat, so this is all the cases we have to consider.
To the right of the := are the answers. Here, if the
argument of an application is 0, the function returns
0. Otherwise n > 0, and in this case it can only be
of the form (nat.succ _), where the _ is the term
that represents the natural number one smaller than
n.
-/

/-
The add2 function, next, is very simple.
-/

def add2 : ℕ → ℕ :=
  fun n, nat.succ (nat.succ n)

/-
Remember how to read a lambda (function) expression.
This definition says that add2 is a function that
takes a nat and returns a nat (that's its type), and
in particular is "the function that when given n as
an argument, applies nat.succ to it twice and returns
that value.
-/

/-
Our tests suggest our functions are working.
-/
example : sub1 0 = 0 := rfl
example : sub1 1 = 0 := rfl
example : sub1 2 = 1 := rfl
example : sub1 3 = 1 := rfl  -- bad test
example : add2 0 = 2 := rfl
example : add2 1 = 3 := rfl
example : add2 2 = 4 := rfl
example : add2 3 = 6 := rfl -- bad test

end impl_cases

/-
Finally we implement the same two functions again using
a Java style of syntax.
-/
namespace impl_cstyle

def sub1 (n : ℕ) : ℕ :=   -- first arg named to left of :
  match n with            -- match in Leandoes case analysis
  | 0 := 0                -- n = 0
  | (n' + 1) := n'        -- n > 0
  end

def add2 (n : ℕ) := n+2   -- n+2 is short for succ(succ n)!

/-
Our tests suggest our functions are working yet again.
-/
example : sub1 0 = 0 := rfl
example : sub1 1 = 0 := rfl
example : sub1 2 = 1 := rfl
example : sub1 3 = 1 := rfl  -- bad test
example : add2 0 = 2 := rfl
example : add2 1 = 3 := rfl
example : add2 2 = 4 := rfl
example : add2 3 = 6 := rfl -- bad test

end impl_cstyle

/-
A new idea you've been seeing in the preceding discussion
is called "destructuring."

Consider the sub1 function. If the argument, n, is zero,
it just returns zero. If the argument is not zero (given
that it must be of type nat) there's no possibility (we
are telling you) for n other than that is the successor
of some other natural number. Even if that other is zero,
is is still 1, and so n > 0.

The way we'll represent a natural number, n, is either as
a term, zero, or as some number of nested applications of
nat.succ to zero. succ(succ(0)) for example represents 3.

Now suppose the argument, n = 3. That's just shorthand for
n = succ (succ (succ 0)) Now look at the second pattern in
our function definitions. It matches when is is of the form
(nat.succ _), where the _ is also a nat value, thus either
zero or (nat.succ _), eventually bottoming out in a zero.

The pattern is (n' + 1), shorthand for (succ n'). Now
let's see what happens when we match (or "unify") it with
the actual argument value, 3, or succ (succ (succ 0)):

    (succ (succ (succ 0)))
    (succ n')

The result ihere is that (1) the pattern matches, and (2)
the name, n', is bound to (succ (succ 0)). Note that if
you plug that in for n' in the pattern you get exactly the
argument value, 3. We've thus got that n' = 2 in this case,
and that's exactly one less than three, which is just what
we wanted.
-/


import .love05_inductive_predicates_demo

/-! # LoVe Exercise 5: Inductive Predicates -/

set_option pp.beta true
set_option pp.generalized_field_notation false

namespace LoVe

/-! ## Question 1: Even and Odd

The `even` predicate is true for even numbers and false for odd numbers. -/

#check even

/-! We define `odd` as the negation of `even`: -/

def odd (n : ℕ) : Prop :=
  ¬ even n

/-! 1.1. Prove that 1 is odd and register this fact as a simp rule.

Hint: `cases'` is useful to reason about hypotheses of the form `even …`. -/

@[simp] lemma odd_1 :
  odd 1 :=
sorry

/-! 1.2. Prove that 3 and 5 are odd. -/

-- enter your answer here

/-! 1.3. Complete the following proof by structural induction. -/

lemma even_two_times :
  ∀m : ℕ, even (2 * m)
| 0       := even.zero
| (m + 1) :=
  sorry

/-! 1.4. Complete the following proof by rule induction.

Hint: You can use the `cases'` tactic (or `match … with`) to destruct an
existential quantifier and extract the witness. -/

lemma even_imp_exists_two_times :
  ∀n : ℕ, even n → ∃m, n = 2 * m :=
begin
  intros n hen,
  induction' hen,
  case zero {
    apply exists.intro 0,
    refl },
  case add_two : k hek ih {
    sorry }
end

/-! 1.5. Using `even_two_times` and `even_imp_exists_two_times`, prove the
following equivalence. -/

lemma even_iff_exists_two_times (n : ℕ) :
  even n ↔ ∃m, n = 2 * m :=
sorry

/-! 1.6 (**optional**). Give a structurally recursive definition of `even` and
test it with `#eval`.

Hint: The negation operator on `bool` is called `not`. -/

def even_rec : nat → bool :=
sorry

/-! ## Question 2: Tennis Games

Recall the inductive type of tennis scores from the demo: -/

#check score

/-! 2.1. Define an inductive predicate that returns true if the server is ahead
of the receiver and that returns false otherwise. -/

inductive srv_ahead : score → Prop
-- enter the missing cases here

/-! 2.2. Validate your predicate definition by proving the following lemmas. -/

lemma srv_ahead_vs {m n : ℕ} (hgt : m > n) :
  srv_ahead (score.vs m n) :=
sorry

lemma srv_ahead_adv_srv :
  srv_ahead score.adv_srv :=
sorry

lemma not_srv_ahead_adv_rcv :
  ¬ srv_ahead score.adv_rcv :=
sorry

lemma srv_ahead_game_srv :
  srv_ahead score.game_srv :=
sorry

lemma not_srv_ahead_game_rcv :
  ¬ srv_ahead score.game_rcv :=
sorry

/-! 2.3. Compare the above lemma statements with your definition. What do you
observe? -/

-- enter your answer here

/-! ## Question 3: Binary Trees

3.1. Prove the converse of `is_full_mirror`. You may exploit already proved
lemmas (e.g., `is_full_mirror`, `mirror_mirror`). -/

#check is_full_mirror
#check mirror_mirror

lemma mirror_is_full {α : Type} :
  ∀t : btree α, is_full (mirror t) → is_full t :=
sorry

/-! 3.2. Define a `map` function on binary trees, similar to `list.map`. -/

def map_btree {α β : Type} (f : α → β) : btree α → btree β
| _ := sorry   -- remove this dummy case and enter the missing cases

/-! 3.3. Prove the following lemma by case distinction. -/

lemma map_btree_eq_empty_iff {α β : Type} (f : α → β) :
  ∀t : btree α, map_btree f t = btree.empty ↔ t = btree.empty :=
sorry

/-! 3.4 (**optional**). Prove the following lemma by rule induction. -/

lemma map_btree_mirror {α β : Type} (f : α → β) :
  ∀t : btree α, is_full t → is_full (map_btree f t) :=
sorry

end LoVe


/-
https://leanprover.github.io/theorem_proving_in_lean4/propositions_and_proofs.html?search=
-/
variable (p q r : Prop)

theorem id_P : p → p :=
  fun hp : p =>
  show p from hp

#print id_P

theorem imp_trans : (p → q) → (q → r) → p → r :=
  fun hPQ : p → q =>
  fun hQR : q → r =>
  fun hP : p =>
  show r from hQR (hPQ hP)

#print imp_trans

theorem and_comm : (p ∧ q) → (q ∧ p) :=
  (fun hPandQ : p ∧ q =>
  have hP : p := And.left hPandQ
  have hQ : q := And.right hPandQ
  show q ∧ p from And.intro hQ hP)

#print and_comm

theorem or_comm : (p ∨ q) → (q ∨ p) :=
  (fun hPorQ : p ∨ q =>
  Or.elim hPorQ (
    fun hP : p =>
      show q ∨ p from Or.intro_right q hP
  )
  (
    fun hQ : q =>
      show q ∨ p from Or.intro_left p hQ

  ))

#print or_comm

theorem noncon : ¬ (p ∧ ¬ p) :=
  (fun hPandNotP: (p ∧ ¬ p) =>
  have hP : p := And.left hPandNotP
  have hNotP : ¬p := And.right hPandNotP
  absurd hP hNotP)

#print noncon

theorem modus_ponens : p → (p → q) → q :=
  (fun hP : p =>
  fun hP_Q : p → q =>
  show q from hP_Q hP)

#print modus_ponens

theorem cond_ident : (¬ p ∨ q) → (p → q) :=
  (
    fun hNP_Q : ¬ p ∨ q =>
    fun hP : p =>
    Or.elim hNP_Q (
      fun hNP : ¬ p =>
      absurd hP hNP
    )
    (
      fun hQ : q =>
      show q from hQ
    )
  )

#print cond_ident

theorem prob3a : (p ∧ q) → (p ∨ r) :=
  fun hPandQ : p ∧ q =>
  have hP := And.left hPandQ
  show p ∨ r from Or.intro_left r hP

#print prob3a

theorem prob3b : p → (q → p) :=
  fun hP : p =>
  fun hQ : q =>
  show p from hP

#print prob3b

example : p ∧ q ↔ q ∧ p :=
  Iff.intro (
    fun hPQ : p ∧ q =>
    have hP := And.left hPQ
    have hQ := And.right hPQ
    show q ∧ p from And.intro hQ hP
  )
  (
    fun hQP : q ∧ p =>
    have hQ := And.left hQP
    have hP := And.right hQP
    show p ∧ q from And.intro hP hQ
  )

example : p ∨ q ↔ q ∨ p :=
  Iff.intro (
    fun hPQ : p ∨ q =>
    Or.elim hPQ (
      fun hP : p =>
      show q ∨ p from Or.intro_right q hP
    )
    (
      fun hQ: q =>
      show q ∨ p from Or.intro_left p hQ
    )
  )
  (
    fun hQP : q ∨ p =>
    Or.elim hQP (
      fun hQ : q =>
      show p ∨ q from Or.intro_right p hQ
    )
    (
      fun hP : p =>
      show p ∨ q from Or.intro_left q hP
    )
  )

example: (p ∧ q) ∧ r ↔ p ∧ (q ∧ r) :=
  Iff.intro (
    fun hPQR :  (p ∧ q) ∧ r =>
    have hP := (And.left (And.left hPQR))
    have hQ := (And.right (And.left hPQR))
    have hR := And.right hPQR
    show p ∧ (q ∧ r) from
    And.intro hP (And.intro hQ hR)
  )
  (
    fun hPQR : p ∧ (q ∧ r) =>
    have hP := (And.left hPQR)
    have hQ := (And.left (And.right hPQR))
    have hR := (And.right (And.right hPQR))
    show (p ∧ q) ∧ r from
    And.intro (And.intro hP hQ) hR
  )

example : (p ∨ q) ∨ r ↔ p ∨ (q ∨ r) :=
  Iff.intro (
    fun hPQR : (p ∨ q) ∨ r =>
    Or.elim hPQR (
      fun hPQ : (p ∨ q) =>
      Or.elim hPQ (
        fun hP : p =>
        show  p ∨ (q ∨ r) from Or.intro_left (q ∨ r) hP
      )
      (
        fun hQ : q =>
        show p ∨ (q ∨ r) from
        Or.intro_right p (Or.intro_left r hQ)
      )
    )
    (
      fun hR : r =>
      show p ∨ (q ∨ r) from
        Or.intro_right p (Or.intro_right q hR)
    )
  )
  (
    fun hPQR : p ∨ (q ∨ r) =>
    Or.elim hPQR (
      fun hP : p =>
      show (p ∨ q) ∨ r from
      Or.intro_left r (Or.intro_left q hP)
    )
    (
      fun hQR : q ∨ r =>
      Or.elim hQR (
        fun hQ : q =>
        show (p ∨ q) ∨ r from
        Or.intro_left r (Or.intro_right p hQ)
      )
      (
        fun hR : r =>
        show (p ∨ q) ∨ r from
        Or.intro_right (p ∨ q) hR
      )
    )
  )

example : p ∧ (q ∨ r) ↔ (p ∧ q) ∨ (p ∧ r) :=
Iff.intro (
  fun hPQR : p ∧ (q ∨ r) =>
  have hP : p := And.left hPQR
  have hQR : q ∨ r := And.right hPQR
  Or.elim hQR (
    fun hQ : q =>
    show (p ∧ q) ∨ (p ∧ r) from
    Or.intro_left (p ∧ r) (And.intro hP hQ)
  )
  (
    fun hR : r =>
    show (p ∧ q) ∨ (p ∧ r) from
    Or.intro_right (p ∧ q) (And.intro hP hR)
  )
)
(
  fun hPQPR : (p ∧ q) ∨ (p ∧ r) =>
  Or.elim hPQPR (
    fun hPQ : p ∧ q =>
    have hP : p := And.left hPQ
    have hQ : q := And.right hPQ
    show p ∧ (q ∨ r) from
    And.intro hP (Or.intro_left r hQ)
  )
  (
    fun hPR : p ∧ r =>
    have hP : p := And.left hPR
    have hR : r := And.right hPR
    show p ∧ (q ∨ r) from
    And.intro hP (Or.intro_right q hR)
  )
)

example : p ∨ (q ∧ r) ↔ (p ∨ q) ∧ (p ∨ r) :=
Iff.intro (
  fun hPQR : p ∨ (q ∧ r) =>
  Or.elim hPQR (
    fun hP : p =>
    have hPQ : p ∨ q := Or.intro_left q hP
    have hPR : p ∨ r := Or.intro_left r hP
    show (p ∨ q) ∧ (p ∨ r) from And.intro hPQ hPR
  )
  (
    fun hQR : q ∧ r =>
    have hPorQ : p ∨ q := Or.intro_right p (And.left hQR)
    have hPorR : p ∨ r := Or.intro_right p (And.right hQR)
    show (p ∨ q) ∧ (p ∨ r) from And.intro hPorQ hPorR
  )
)
(
  fun hPQPR : (p ∨ q) ∧ (p ∨ r) =>
  have hPQ : p ∨ q := And.left hPQPR
  have hPR : p ∨ r := And.right hPQPR
  Or.elim hPQ (
    fun hP : p =>
    show p ∨ (q ∧ r) from Or.intro_left (q ∧ r) hP
  )
  (
    fun hQ : q =>
    Or.elim hPR (
      fun hP : p =>
      show p ∨ (q ∧ r) from Or.intro_left (q ∧ r) hP
    )
    (
      fun hR : r =>
      show p ∨ (q ∧ r) from Or.intro_right p (And.intro hQ hR)
    )
  )
)

example : (p → (q → r)) ↔ (p ∧ q → r) :=
Iff.intro (
  fun hP_Q_R: p → (q → r) =>
  fun hPQ : p ∧ q =>
  have hP : p := And.left hPQ
  have hQ : q := And.right hPQ
  show r from hP_Q_R hP hQ
)
(
  fun hPQ_R : (p ∧ q → r) =>
  fun hP : p =>
  fun hQ : q =>
  have hPQ : p ∧ q := And.intro hP hQ
  show r from hPQ_R hPQ
)

example : ((p ∨ q) → r) ↔ (p → r) ∧ (q → r) :=
Iff.intro (
  fun hPorQ_R: (p ∨ q) → r =>
  have hP_R: p → r := (
    fun hP : p =>
    have hPorQ: p ∨ q := Or.intro_left q hP
    show r from hPorQ_R hPorQ
  )
  have hQ_R: q → r := (
    fun hQ : q =>
    have hPorQ: p ∨ q := Or.intro_right p hQ
    show r from hPorQ_R hPorQ
  )
  show (p → r) ∧ (q → r) from And.intro hP_R hQ_R
)
(
  fun hPRandQR: (p → r) ∧ (q → r) =>
  fun hPorQ: p ∨ q =>
  have hPR: p → r := And.left hPRandQR
  have hQR: q → r := And.right hPRandQR
  Or.elim hPorQ (
    fun hP: p =>
    show r from hPR hP
  )
  (
    fun hQ: q =>
    show r from hQR hQ
  )
)

example : ¬(p ∨ q) ↔ ¬p ∧ ¬q :=
Iff.intro (
  fun hPQ : ¬ (p ∨ q) =>
  have hnP: ¬p := (
    fun hP : p =>
    have hPorQ : p ∨ q := Or.intro_left q hP
    absurd hPorQ hPQ
  )
  have hnQ: ¬q := (
    fun hQ : q =>
    have hPorQ : p ∨ q := Or.intro_right p hQ
    absurd hPorQ hPQ
  )
  show ¬p ∧ ¬q from And.intro hnP hnQ
)
(
  fun hNPandNQ : ¬p ∧ ¬q =>
  have NP : ¬p := And.left hNPandNQ
  have NQ : ¬q := And.right hNPandNQ
  show ¬(p ∨ q) from (
    fun PorQ : p ∨ q =>
    Or.elim PorQ (
      fun P : p => absurd P NP
    )
    (
      fun Q : q => absurd Q NQ
    )
  )
)

example : ¬p ∨ ¬q → ¬(p ∧ q) :=
fun hNPorNQ : ¬p ∨ ¬q =>
Or.elim hNPorNQ (
  fun hNP : ¬p =>
  show ¬(p ∧ q) from (
    fun PandQ: p ∧ q =>
    absurd (And.left PandQ) hNP
  )
)
(
  fun hNQ : ¬q =>
  show ¬(p ∧ q) from (
    fun PandQ: p ∧ q =>
    absurd (And.right PandQ) hNQ
  )
)

example : ¬(p ∧ ¬p) :=
fun hPandNP: p ∧ ¬p =>
absurd (And.left hPandNP) (And.right hPandNP)

example : p ∧ ¬q → ¬(p → q) :=
fun hPandNQ : p ∧ ¬q =>
have hP: p := And.left hPandNQ
have hNQ : ¬q := And.right hPandNQ
show ¬(p → q) from (
  fun hP_Q : p → q =>
  absurd (hP_Q hP) hNQ
)

example : ¬p → (p → q) := (
  fun hNP: ¬p =>
  fun hP: p =>
  show q from absurd hP hNP
)

example : (¬p ∨ q) → (p → q) :=
fun hNPorQ : ¬ p ∨ q =>
fun hP : p =>
Or.elim hNPorQ (
  fun hNP : ¬p =>
  show q from absurd hP hNP
)
(
  fun hQ : q =>
  show q from hQ
)

example : p ∨ False ↔ p :=
Iff.intro (
  fun hPorFALSE: p ∨ False =>
  Or.elim hPorFALSE (
    fun hP : p =>
    show p from hP
  )
  (
    fun hFALSE: False =>
    show p from False.elim hFALSE
  )
)
(
  fun hP : p =>
  show p ∨ False from Or.intro_left False hP
)

example : p ∧ False ↔ False :=
Iff.intro (
  fun hPandFALSE : p ∧ False =>
  show False from And.right hPandFALSE
)
(
  fun hFALSE: False =>
  show p ∧ False from False.elim hFALSE
)

example : (p → q) → (¬q → ¬p) :=
fun hP_Q: p → q =>
fun hnQ: ¬q =>
show ¬p from (
  fun hP : p =>
  have hQ : q := hP_Q hP
  absurd hQ hnQ
)


import Scripts.set_theory
--===================--
------ TOPOLOGÍA ------
--===================--

-- Un espacio topológico sobre un tipo α viene dado por un predicado 'is_open' sobre los conjuntos de
-- elementos de α junto con las pruebas de que ese predicado cumple los axiomas de la topología
structure topological_space (α : Type u) where
  is_open : Set α → Prop
  is_open_univ : is_open univ
  is_open_inter : ∀ (s t : Set α), is_open s → is_open t → is_open (s ∩ t)
  is_open_union : ∀ (F : Set (Set α)), (∀ s, s ∈ F → is_open s) → is_open (⋃₀ F)

--Dos espacios tienen la misma topología si tienen los mismos abiertos
theorem topological_space_eq : ∀ T T' : topological_space α, T.is_open = T'.is_open → T = T' :=
fun ⟨p, _, _, _⟩ ⟨p', _, _, _⟩ h => by simp [h]

theorem topological_space_eq_iff (T : topological_space α) (T' : topological_space α) :
  (∀ s, T.is_open s ↔ T'.is_open s) ↔ T = T' :=
    ⟨fun h => topological_space_eq T T' (setext @h),
     fun h _ => h ▸ Iff.rfl⟩

-- Por comodidad
attribute [class] topological_space
def is_open [T : topological_space α] : Set α → Prop := T.is_open

-- El vacío siempre es un abierto
theorem is_open_empty {α : Type u} [T : topological_space α] : is_open (∅ : Set α) :=
  have h : is_open (⋃₀ (∅ : Set (Set α))) :=
     T.is_open_union ∅ (fun _ => fun h => h.elim)
  unionF_empty ▸ h

-- Un conjunto es cerrado si su complementario es abierto
def is_closed [topological_space α] (s : Set α) : Prop := is_open (-s)

-- Una topología también puede definirse dando los cerrados
def topological_space_of_is_closed (is_closed : Set α → Prop) (is_closed_empty : is_closed empty)
  (is_closed_union : ∀ (s t : Set α), is_closed s → is_closed t → is_closed (s ∪ t))
  (is_closed_inter : ∀ (F : Set (Set α)), (∀ s, s ∈ F → is_closed s) → is_closed (⋂₀ F)) :
  topological_space α :=
  {
    is_open := fun s => is_closed (-s),
    is_open_univ := show is_closed (-univ) from eq_compl_univ ▸ is_closed_empty,
    is_open_inter := fun s t hs ht =>
        show is_closed (-(s ∩ t)) from compl_inter_eq_union_compl ▸ (is_closed_union (-s) (-t) hs ht),
    is_open_union := fun F h_open =>
      have h_closed_cF : ∀ s, s ∈ complF F → is_closed s :=
        fun s (h_cF_s : complF F s ) =>
          have h_ccs : is_closed (-(-s)) := h_open (-s) h_cF_s
          @compl_compl_eq α s ▸ h_ccs
      show is_closed (-(⋃₀ F)) from compl_unionF ▸ (is_closed_inter (complF F) h_closed_cF)
  }


import data.real.basic

/-!

# Linear arithmetic

We've used the tactic `linarith` to prove statements that follow from linear
(in)equalities in the local context.

For convenience we will work over a linear ordered ring, although this makes sense
with weaker assumptions.

An expression is *linear* in variables `x₁ ... xₙ` if it is a polynomial of degree
at most one: that is, it is a sum of products `cᵢ * xᵢ`, where each `cᵢ` is a
coefficient.

The key point: variables are not multiplied together.
`5*x + 3*y` is linear, but `5*x*y` is not.

An (in)equality is linear if it is of the form `a ⋈ b`, where
⋈ is <, ≤ =, ≥, or >, and a and b are linear expressions.
-/

example (ε : ℚ) (h1 : ε > 0) : ε / 2 + ε / 3 + ε / 7 < ε :=
 by linarith

example (g v V c h : ℚ) (h1 : h = 0) (h2 : v = V) (h3 : V > 0) (h4 : g > 0)
         (h5 : 0 ≤ c) (h6 : c < 1) :
  v ≤ V :=
by linarith

example (N : ℕ) (n : ℕ) (A : ℚ) (l : ℚ) (Hirrelevant : n > N)
        (h : A - l ≤ -(A - l)) (h_1 : ¬A ≤ -A) (h_2 : ¬l ≤ -l) (h_3 : -(A - l) < 1) :
  A < l + 1 :=
by linarith

/-!
We're interested in the problem of deciding whether a system of linear
inequalities is *satisfiable*:

Given
    h1 : a₁¹x₁ + a₂¹x₂ + ... + aₙ¹xₙ ⋈¹ 0
    h2 : a₁²x₁ + a₂²x₂ + ... + aₙ²xₙ ⋈² 0
    h3 : a₁³x₁ + a₂³x₂ + ... + aₙ³xₙ ⋈³ 0
    ...
    hk : a₁ᵏx₁ + a₂ᵏx₂ + ... + aₙᵏxₙ ⋈ᵏ 0

is there an assignment of variables to values
    x₁ ↦ v₁, x₂ ↦ v₂, ..., xₙ ↦ vₙ
that makes each of h1 ... hk true?

Note: if we can decide this, we can decide implications like in the examples above.
For a linear inequality `h`,
the implication `(h1 ∧ h2 ∧ ... ∧ hk) → h` is valid exactly when the system
`h1, h2, ... hk, ¬ h` is unsatisfiable.

## Verified decision procedures

To implement a tactic like `linarith`, we need to do more than just decide
these kinds of statements: we need to prove that our decisions are correct.

What are our options here?

### Proof by reflection

We talked about proof by reflection on Monday.
To do this, we'd have to represent the syntax of linear expressions as a datatype,
define our decision procedure in Lean,
and prove that it's correct with respect to an interpretation function.

This is probably doable! But executing our decision procedure would happen
in Lean's (slow, reliable) kernel. All numeric arithmetic would be done in unary.

### "Prove-as-we-go"

The simple tactics we implemented just updated the goal and context directly.
Presumably, some decision procedures here will make intermediate claims:
they'll start with h1 ... hk, derive new facts from those,
derive new facts from those, ...
We could imagine a tactic that just fills up the local context with new conclusions,
until it proves the goal or terminates. (Details depending on the algorithm.)

Is this efficient? It depends on how much unnecessary work the tactic does...

### Certificate checking

Our input is
    h1 : a₁¹x₁ + a₂¹x₂ + ... + aₙ¹xₙ ⋈¹ 0
    h2 : a₁²x₁ + a₂²x₂ + ... + aₙ²xₙ ⋈² 0
    h3 : a₁³x₁ + a₂³x₂ + ... + aₙ³xₙ ⋈³ 0
    ...
    hk : a₁ᵏx₁ + a₂ᵏx₂ + ... + aₙᵏxₙ ⋈ᵏ 0
and our goal is to prove `false`.
We can assume that each ⋈ⁱ is <, ≤, or =.

Suppose we had an oracle that produced a list of nonnegative coefficients
c₁ ... cₖ such that
* c₁ * (a₁¹x₁ + a₂¹x₂ + ... + aₙ¹xₙ) + c₂ * (a₁²x₁ + a₂²x₂ + ... + aₙ²xₙ)
  + ... + cₖ * (a₁ᵏx₁ + a₂ᵏx₂ + ... + aₙᵏxₙ) = 0
* For at least one i, cᵢ > 0 and ⋈ⁱ is =.

We could then prove false by summing together the scaled linear expressions;
this sum must be both equal to and less than 0.

This list of coefficients c₁ ... cₖ is a *certificate* for the unsatisfiability
of the system of inequalities.

Efficiently finding such a certificate can be very hard.
But given such a certificate, it's easy to turn it into a proof term.

## Mathlib's linarith tactic

`linarith` in mathlib follows the certificate checking approach.

* Preprocessing: manipulate the context and goal to prepare for the main tactic.
* Parsing: find the linear structure of the hypotheses.
* Certificate generation: using these parsed linear (in)equalities, find coefficients
  c1 ... ck. (Needs: a certificate-producing oracle.)
* Validation: use this certificate to prove `0 < 0`.
  (Needs: a normalization tactic to reduce the sum of products to 0.)

-/

#check tactic.interactive.linarith
#check linarith.linear_forms_and_max_var
#check linarith.comp

/-!

Certificate generation is the computationally expensive part of this process.

Note, we don't need to assume anything about it:
the certificate procedure can be an oracle.

There are lots and lots of algorithms out there for doing this.
Simplex is a familiar and efficient technique (but can be hard to implement
efficiently in a pure functional language.)

Mathlib's approach: Fourier-Motzkin elimination.

Start with
    h1 : a₁¹x₁ + a₂¹x₂ + ... + aₙ¹xₙ ⋈¹ 0
    h2 : a₁²x₁ + a₂²x₂ + ... + aₙ²xₙ ⋈² 0
    h3 : a₁³x₁ + a₂³x₂ + ... + aₙ³xₙ ⋈³ 0
    ...
    hk : a₁ᵏx₁ + a₂ᵏx₂ + ... + aₙᵏxₙ ⋈ᵏ 0

Pick a variable to eliminate: let's say xₙ.

Partition h1...hk into three sets pos, zero, neg:
    pos  = {hi | aₙⁱ > 0}
    zero = {hi | aₙⁱ = 0}
    neg  = {hi | aₙⁱ < 0}

Set aside zero; xₙ has already been eliminated from these.

For each pair of hp ∈ pos and hn ∈ neg:
* find positive cp, cn such that `cp*aₚ + cn*aₙ = 0`.
* compute the sum `cp*hp + cn*hn`. This is a new comparison.
* add this sum to the set zero, tracking that it was derived from
  (cp, hp) and (cn, hn).

After this process, zero is a set of comparisons that do not contain xₙ.

Theorem: over a dense linear ordered field,
the initial set {h1, ... hk} is satisfiable
iff the new set zero is satisfiable.

So, by successively eliminating all of the variables from our initial system,
we end up with a list of comparisons 0 ⋈ⁱ 0.
If any ⋈ⁱ is <, we've found a contradiction.
Tracing the history of how this comparison was derived, we can compute how many
copies of each original hi were added to derive it.
This produces the certificate we wanted.
-/

#check linarith.fourier_motzkin.produce_certificate

/-!

But: nothing about the rest of linarith assumes that this is the algorithm
used to generate certificates. It just needs a valid certificate in the right format.

We can use external software such as Mathematica to generate these:
perhaps more efficiently, perhaps not.

## Nonlinear arithmetic

You can imagine problems that are just outside this framework.

-/

example (x y : ℚ) : 0 ≤ x*x + y*y :=
by linarith

/-!
Turns out: these problems are also decidable!

(Old result by Tarski; modern algorithms like cylindrical algebraic decomposition)

But algorithms are very slow, and/or hard to produce proofs.

Hard to separate *proof search* from the ultimate proof:
the justification is that the entire search was carried out correctly.

But for tactic implementations, we don't necessarily need decision procedures.
-/

example (x y : ℚ) : 0 ≤ x*x + y*y :=
by nlinarith


/-
Copyright (c) 2021 Kexing Ying. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kexing Ying, Eric Wieser
-/
import data.real.basic

/-!
# Real sign function

This file introduces and contains some results about `real.sign` which maps negative
real numbers to -1, positive real numbers to 1, and 0 to 0.

## Main definitions

 * `real.sign r` is $\begin{cases} -1 & \text{if } r < 0, \\
                               ~~\, 0 & \text{if } r = 0, \\
                               ~~\, 1 & \text{if } r > 0. \end{cases}$

## Tags

sign function
-/

namespace real

/-- The sign function that maps negative real numbers to -1, positive numbers to 1, and 0
otherwise. -/
noncomputable
def sign (r : ℝ) : ℝ :=
if r < 0 then -1 else
if 0 < r then 1 else
0

lemma sign_of_neg {r : ℝ} (hr : r < 0) : sign r = -1 :=
by rw [sign, if_pos hr]

lemma sign_of_pos {r : ℝ} (hr : 0 < r) : sign r = 1 :=
by rw [sign, if_pos hr, if_neg hr.not_lt]

@[simp]
lemma sign_zero : sign 0 = 0 :=
by rw [sign, if_neg (lt_irrefl _), if_neg (lt_irrefl _)]

@[simp]
lemma sign_one : sign 1 = 1 :=
sign_of_pos $ by norm_num

lemma sign_apply_eq (r : ℝ) : sign r = -1 ∨ sign r = 0 ∨ sign r = 1 :=
begin
  obtain hn | rfl | hp := lt_trichotomy r (0 : ℝ),
  { exact (or.inl $ sign_of_neg hn) },
  { exact (or.inr $ or.inl $ sign_zero) },
  { exact (or.inr $ or.inr $ sign_of_pos hp) },
end

/-- This lemma is useful for working with `units ℝ` -/
lemma sign_apply_eq_of_ne_zero (r : ℝ) (h : r ≠ 0) : sign r = -1 ∨ sign r = 1 :=
begin
  obtain hn | rfl | hp := lt_trichotomy r (0 : ℝ),
  { exact (or.inl $ sign_of_neg hn) },
  { exact (h rfl).elim },
  { exact (or.inr $ sign_of_pos hp) },
end

@[simp]
lemma sign_eq_zero_iff {r : ℝ} : sign r = 0 ↔ r = 0 :=
begin
  refine ⟨λ h, _, λ h, h.symm ▸ sign_zero⟩,
  obtain hn | rfl | hp := lt_trichotomy r (0 : ℝ),
  { rw [sign_of_neg hn, neg_eq_zero] at h, exact (one_ne_zero h).elim },
  { refl },
  { rw sign_of_pos hp at h, exact (one_ne_zero h).elim },
end

lemma sign_int_cast (z : ℤ) : sign (z : ℝ) = ↑(int.sign z) :=
begin
  obtain hn | rfl | hp := lt_trichotomy z (0 : ℤ),
  { rw [sign_of_neg (int.cast_lt_zero.mpr hn), int.sign_eq_neg_one_of_neg hn, int.cast_neg,
      int.cast_one], },
  { rw [int.cast_zero, sign_zero, int.sign_zero, int.cast_zero], },
  { rw [sign_of_pos (int.cast_pos.mpr hp), int.sign_eq_one_of_pos hp, int.cast_one] }
end

lemma sign_neg {r : ℝ} : sign (-r) = - sign r :=
begin
  obtain hn | rfl | hp := lt_trichotomy r (0 : ℝ),
  { rw [sign_of_neg hn, sign_of_pos (neg_pos.mpr hn), neg_neg] },
  { rw [sign_zero, neg_zero, sign_zero] },
  { rw [sign_of_pos hp, sign_of_neg (neg_lt_zero.mpr hp)] },
end

lemma sign_mul_nonneg (r : ℝ) : 0 ≤ sign r * r :=
begin
  obtain hn | rfl | hp := lt_trichotomy r (0 : ℝ),
  { rw sign_of_neg hn,
    exact mul_nonneg_of_nonpos_of_nonpos (by norm_num) hn.le },
  { rw mul_zero, },
  { rw [sign_of_pos hp, one_mul],
    exact hp.le }
end

lemma sign_mul_pos_of_ne_zero (r : ℝ) (hr : r ≠ 0) : 0 < sign r * r :=
begin
  refine lt_of_le_of_ne (sign_mul_nonneg r) (λ h, hr _),
  have hs0 := (zero_eq_mul.mp h).resolve_right hr,
  exact sign_eq_zero_iff.mp hs0,
end

@[simp]
lemma inv_sign (r : ℝ) : (sign r)⁻¹ = sign r :=
begin
  obtain (hn | hz | hp) := sign_apply_eq r,
  { rw hn, norm_num },
  { rw hz, exact inv_zero },
  { rw hp, exact inv_one }
end

@[simp]

end real


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

import tactic -- imports all the Lean tactics

/-!

# Group theory in Lean

Lean has groups. But let's make our own anyway. In this sheet we will
learn about the `class` command, which is one of the ways to make
a theory of groups in Lean (and indeed the way it's done in `mathlib`)

We will also learn about `simp`, a tactic which does long series of
rewrites automatically. We'll even learn how to train it to solve a
certain kind of problem.

## Definition of a group

`group G` is already defined in `mathlib`, so let's define a new
type `mygroup G`. Here `G : Type` is a type, and `mygroup G` is the type of
group structures on `G`.

-/

/-- `mygroup G` is the type of group structures on the type `G`. -/
class mygroup (G : Type)
  extends has_one G, has_mul G, has_inv G : Type :=
(mul_assoc : ∀ a b c : G, (a * b) * c = a * (b * c))
(one_mul : ∀ a : G, 1 * a = a)
(mul_one : ∀ a : G, a * 1 = a)
(inv_mul_self : ∀ a : G, a⁻¹ * a = 1)
(mul_inv_self : ∀ a : G, a * a⁻¹ = 1)

/-

Right now the axioms are called `mygroup.mul_assoc`, `mygroup.one_mul` etc.
Furthermore we want to build some lemmas called things like `mygroup.one_inv`
and stuff. The fix? Let's move into the `mygroup` namespace, where they're
just caled `mul_assoc`, `one_inv` etc.

-/

namespace mygroup

-- tag all the axioms for groups with the `@[simp]` attribute.
-- Note that we can drop the `mygroup` prefix now as we're in the namespace.

attribute [simp] mul_assoc one_mul mul_one inv_mul_self mul_inv_self

-- Throughout our work in this namespace, let `G` be a group and let
-- `a`, `b` and `c` be elements of `G`.
variables {G : Type} [mygroup G] (a b c : G)

/-

Five of the next seven lemmas are tagged with `@[simp]` as well.
See if you can prove all seven using (for the most part) the `rw` tactic.

-/

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

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

lemma left_inv_eq_right_inv {a b c : G} (h1 : b * a = 1) (h2 : a * c = 1) :
  b = c :=
begin
  have h : b * (a * c) = (b * a) * c := (mul_assoc b a c).symm, -- dot notation
  simpa [h2, h1] using h,
end

lemma mul_eq_one_iff_eq_inv : a * b = 1 ↔ a⁻¹ = b :=
⟨left_inv_eq_right_inv (inv_mul_self a), begin
  rintro rfl,
  simp
end⟩

@[simp] lemma one_inv : (1 : G)⁻¹ = 1 :=
begin
  simp [← mul_eq_one_iff_eq_inv],
end

@[simp] lemma inv_inv : (a⁻¹)⁻¹ = a :=
begin
  simp [← mul_eq_one_iff_eq_inv],
end

@[simp] lemma mul_inv_rev : (a * b)⁻¹ = b⁻¹ * a⁻¹ :=
begin
  simp [← mul_eq_one_iff_eq_inv],
end

/-

Remember the `ring` tactic which didn't look at hypotheses but which could
prove hypothesis-free identities in commutative rings? A theorem of Knuth
and Bendix says that we have just trained Lean's simplifier to prove
arbitrary true hypothesis-free identities in groups; those ten lemmas
we tagged with `@[simp]` are all you need. We've made a Noetherian
confluent rewrite system for group theory!

-/
-- example of Knuth-Bendix theorem
example (G : Type) [mygroup G] (a b : G) :
  (b⁻¹ * a⁻¹)⁻¹ * 1⁻¹⁻¹ * b⁻¹ * (a⁻¹ * a⁻¹⁻¹⁻¹) * a = 1 := by simp

-- bonus puzzle : if g^2=1 for all g in G, then G is abelian
example (G : Type) [mygroup G] (h : ∀ g : G, g * g = 1) :
  ∀ g h : G, g * h = h * g :=
begin
  simp [mul_eq_one_iff_eq_inv] at h,
  intros a b,
  rw [← h (a * b)],
  rw mul_inv_rev,
  simp [h],
end

end mygroup


import Mathlib.Data.Real.Basic

/-!
# IMO 2011 Q3

Let f : ℝ → ℝ be a function that satisfies

   f(x + y) ≤ y * f(x) + f(f(x))

for all x and y. Prove that f(x) = 0 for all x ≤ 0.

# Solution

Direct translation of the solution found in https://www.imo-official.org/problems/IMO2011SL.pdf
-/

theorem imo2011_q3 (f : ℝ → ℝ) (hf : ∀ x y, f (x + y) ≤ y * f x + f (f x)) :
  ∀ x ≤ 0, f x = 0 := by
  -- reparameterize
  have hxt : ∀ x t, f t ≤ t * f x - x * f x + f (f x) := by
    intros x t
    calc f t = f (x + (t - x))             := by rw [add_eq_of_eq_sub' rfl]
           _ ≤ (t - x) * f x + f (f x)     := hf x (t - x)
           _ = t * f x - x * f x + f (f x) := by rw [sub_mul]

  have h_ab_combined : ∀ a b, a * f a + b * f b ≤ 2 * f a * f b := by
    intros a b
    linarith [hxt b (f a), hxt a (f b)]

  have h_f_nonneg_of_pos : ∀ a < 0, 0 ≤ f a := by
    intros a han
    have : a * f a ≤ 0 := add_le_iff_nonpos_left.mp (h_ab_combined a (2 * f a))
    exact nonneg_of_mul_nonpos_right this han

  have h_f_nonpos : ∀ x, f x ≤ 0 := by
    intros x
    by_contra h_suppose_not
    -- If we choose a small enough argument for f, then we get a contradiction.
    let s := (x * f x - f (f x)) / (f x)
    have hm : min 0 s - 1 < s := (sub_one_lt _).trans_le (min_le_right 0 s)
    have hml : min 0 s - 1 < 0 := (sub_one_lt _).trans_le (min_le_left 0 s)
    suffices f (min 0 s - 1) < 0 by
      exact not_le.mpr this (h_f_nonneg_of_pos (min 0 s - 1) hml)

    have hp : 0 < f x := not_le.mp h_suppose_not
    calc f (min 0 s - 1)
         ≤ (min 0 s - 1) * f x - x * f x + f (f x) := hxt x (min 0 s - 1)
       _ < s * f x - x * f x + f (f x) :=
               by linarith [(mul_lt_mul_right hp).mpr hm]
       _ = 0 := by rw [(eq_div_iff hp.ne.symm).mp rfl]; linarith

  have h_fx_zero_of_neg : ∀ x < 0, f x = 0 := by
    intros x hxz
    exact (h_f_nonpos x).antisymm (h_f_nonneg_of_pos x hxz)

  intros x hx
  obtain (h_x_neg : x < 0) | (rfl : x = 0) := hx.lt_or_eq
  · exact h_fx_zero_of_neg _ h_x_neg
  · suffices 0 ≤ f 0 by exact (h_f_nonpos 0).antisymm this
    have hno : f (-1) = 0 := h_fx_zero_of_neg (-1) neg_one_lt_zero
    have hp := hxt (-1) (-1)
    rw [hno] at hp
    linarith


import group_theory.subgroup data.set.basic algebra.group data.equiv
import xenalib.Ellen_Arlt_matrix_rings

-- sheet 5
variables {G : Type*} [group G]
variables (H K : set G)
variables [is_subgroup H] [is_subgroup K]

-- 1. Recall that for a matrix A = (aij), the transpose of A is the matrix AT = (bij), where bij = aji. Let G = GL(2,R), and let H ⊆ G be the subset
-- H ={A∈G|ATA=I}.
-- (a) Show that H is a subgroup of G.
-- (b) What are the possible determinants for an element of H?
-- (c) Show that the elements of H with determinant 1 form a subgroup K of
-- G.
-- (d) Prove that, with K as in (c):
-- 􏰄􏰂cosθ −sinθ􏰃 􏰅 K = sin θ cos θ : θ ∈ R
-- .
-- (e) Find an element of H of order 3, and another with infinite order.
-- (f) Show that K is abelian. Is H abelian?
-- (g) Generalize parts (a), (b), (c).

-- 2∗. Which of the following subsets H are subgroups of the given group G?
-- (a) G=(Z,+),H={n∈Z|n≡0mod37}.
-- (b) G=GL(2,C),H={A∈G|A2 =I}.
-- (c) G=GL(2,R),H={A∈G|det(A)=1}.
-- (d) G=Sn,H={g∈G|g(1)=1}(forn∈N).
-- (e) G=Sn,H={g∈G|g(1)=2}.
-- (f) G=Sn,H isthesetofallpermutationsg∈Gsuchthat g(i) − g(j) ≡ i − j mod n for all i, j ∈ {1, . . . , n}.

-- 3. Let G be a group with subgroups H and K.
-- (a) Prove that H ∩ K is a subgroup of G.
theorem sheet05_q3a: is_subgroup(H ∩ K) := sorry
-- (b) Show that H ∪ K is not a subgroup, unless either H ⊆ K or K ⊆ H.
theorem sheet05_q3b (hp:¬(H ⊆ K ∨ K ⊆ H)): ¬is_subgroup(H ∪ K) := sorry

-- 4. Prove the following statements.
definition is_cyclic (G : Type*) [group G] := ∃ x : G, gpowers x = set.univ
-- (a) Every cyclic group is abelian.
theorem sheet05_q4a : is_cyclic G → comm_group G := sorry
--{ ..is_subgrou }
definition gsymmetric (n : ℕ) := equiv.perm (fin n)
-- (b) The symmetric group is not abelian, unless n < 3.
theorem sheet05_q4b (n : ℕ) (n < 3) : comm_group (gsymmetric n) → gsymmetric n := sorry

-- 5. Find an example of each of the following:
-- (a) an element of order 3 in the group GL(2, C).
-- (b) an element of order 3 in the group GL(2, R).
-- (c) an element of infinite order in the group GL(2, R). (d) an element of order 12 in the group S7.

-- 6. Let G=S₅.
-- (a) Show that any element of G which fixes exactly two points in {1, 2, 3, 4, 5}
-- must have order 3.
-- (b) What are the possible orders of a cyclic subgroup of G?
-- (c) Find a proper subgroup of G which is not cyclic.

-- 7. Which of the following groups are cyclic? Prove one statement, delete the other.
-- (a)
theorem sheet05_q7a_is_T : gsymmetric 2 → is_cyclic G := sorry
theorem sheet05_q7a_is_F : ¬ (gsymmetric 2 → is_cyclic G) := sorry
-- (b)
theorem sheet05_q7b_is_T : group (GL 2 R) → is_cyclic G := sorry
theorem sheet05_q7b_is_F : group (GL 2 R) → ¬ (is_cyclic G) := sorry􏰃
-- (c) 0 b |
-- (d) (Q,+). a, b ∈ {1, −1}
-- under matrix multiplication.


/-
There are direct parallels between
computational and logical types. The
unit data type corresponds to the
propositional/logical type, true:
each has one value/proof. The empty
data type has no constructors and so
has no values. It is an uninhabited
data type. It corresponds directly
to the proposition, false: a logical
type with no constructors and thus
no proofs. That is just what makes
it false!
-/

#check unit
#print unit

#check empty
#print empty

#check true
#print true
#print false

/-
The true proposition is trivially provable.
And that is what makes it always true. The
introduction rule is called true introduction
or, in Lean, true.intro.
-/
theorem trueIsTrue : true := true.intro

/-
There is no proof of false, and thus there
is no introduction rule for false!
-/
theorem falseIsTrue : false := _    -- stuck

/-
There is however an elimination rule for
false. The intuition is that if you ever
get to a place where you've deduced a proof
of false, then you must have made an invalid
assumption along the way, so it makes no
sense to reason any further, and the current
goal, whatever it is, can simply be ignored.
Note that arguments to functions are assumed
values! The following example show that if
you assume you are given a proof of false,
then even a crazy goal can be "discharged",
here the goal of showing 0 = 1.
-/
def falseImpliesCrazy (f : false) : 0 = 1 :=
false.elim f

/-
The preceding function definition is
equivalent to the following proof of
the smae implication.
-/
example : false → 0 = 1 :=
λ (f : false),
    false.elim f

/-
We can now generalize to a universal
law of predicate logic: that for any
proposition, P, false → P. This is the
rule called ex falso quod libet: from
false anything follows.
-/
example : ∀ (P : Prop), false → P :=
λ (P : Prop),
    λ (f : false),
        false.elim f

/-
We can not introduce and understand
the concept of logical negation. If
P is an proposition, then not P, or
¬ P for shorthand, is the negation
of P. It asserts that P is false.
What that means in turn is that there
can be no proof of P. We will now see
how to prove that P is false. This
leads us to the "proof strategy" of
"proof by negation."
-/

/-
To show that P is false, show that
assuming that P is true enables one
to derive a proof of false, i.e., it
leads to a contradiction. Given that
a proof cannot be, the assumption
that there is a proof of P must
have been incorrect. Therefore
there is no proof of P, P is false,
and we can now state correctly that
¬ P is true.
-/

#print not

/-
KEY IDEA: ¬ P is defined to mean
P → false. So whenever you see
¬ P, remember that it literally
means P → false. If you are asked
to prove ¬ P, proceed by trying
to prove P → false. You'd do this
by assuming P and showing that that
leads to a contradiction and thus
a proof of false. Again, this is
the strategy of proof by negation.
It's just the definition of ¬.
-/

/-
To facilitate the following
examples, we will now assume that
P is some arbitrary proposition.
-/
axiom P : Prop

/-
Now ¬ P is also a proposition.
-/
#check ¬ P

/-
And it is defined to mean P → false.
-/
#reduce ¬ P

/-
Proof by negation! Assume P, show
that that enables one to deduce a
proof of false.
-/
example : ¬ P :=
λ (p : P),
    _

/-
Contradiction. Key idea: a proof of
P → false can be *applied* to a proof
of P to derive a proof of false. From
there, as the next example shows, one
can use false elimination to complete
any proof.
-/
example : P → ¬ P → false :=
λ (p :P),
    λ (np : ¬ P),
        (np p)

example : P → ¬ P → false :=
begin
    assume (p : P),
    assume (np : P → false),
    exact (np p),
end

/-
We want to prove that if P is true
then if ¬ P is also true then 0 = 1
is true. Assume P is true and that
¬ P is also true and show that false
is true. Apply ¬ P to P to get false.
QED.
-/

example : P → ¬ P → 0 = 1 :=
begin
assume (p : P),
assume (np : ¬ P),
exact false.elim (np p),
end

/-

    *** The or ∨ Connective ***

-/

/-
We assume now that Q is a proposition
and that we have a proof of it, q.
-/
axiom Q : Prop
axiom q : Q

/-
There are two introduction rules for or.
The first, or.inl takes a proof of P and
returns a proof of P ∨ Q. The second, inr,
takes a proof of Q and returns a proof of
P ∨ Q. The following example illustrates
the use of inr, as inl cannot be used in
this case (because we don't have a proof
of P).
-/
example : P ∨ Q :=
or.inr q

example : 0 = 1 ∨ 2 = 2 :=
or.inr
    (eq.refl 2)

example : (P ∧ Q) ∨ Q :=
or.inr q

-- or.intro_right (0 = 1) rfl
/-
In classical but not in constructive logic,
P ∨ ¬ P is true for any proposition P. We
have to add this as an axiom to Lean if we
want to reason "classically" when using this
proof assistant.
-/

/-
Reminder: What does ¬ P mean?
-/

-- CONSTRUCTIVE LOGIC
example : P ∨ ¬ P :=
begin
_
end

-- CLASSICAL LOGIC
axiom em : ∀ (P : Prop), P ∨ ¬ P

#check em Q

example : ∀ (P : Prop), ¬ (¬ P) → P :=
begin
assume (P : Prop),
assume (nnp : ¬ ¬ P),
cases (em P),
exact h,
have f : false := (nnp h),
exact false.elim f,
end

example : ∀ (P : Prop), ¬ (¬ P) → P :=
λ (P : Prop),
    λ (nnp : ¬ ¬ P),
        match (em P) with
        | or.inl p := p
        | or.inr np := false.elim
            (nnp np)
        end

/-
Proof by contradiction. Want to show
P. Show that ¬ P → false. That is, show
¬ ¬ P. Use theorem that ¬ ¬ P → P, which
requires the law of the excluded middle.
-/

/-
Being a proof of a universal generalization,
we can *apply* em to any proposition, P, to
obtain a proof of P ∨ ¬ P.
-/
example : P ∨ ¬ P :=
em P

example : Q ∨ ¬ Q :=
em Q

#check em Q

/-
What we do to use** such a proof, or any
proof of a disjunction, P ∨ Q, is to reason
by case analysis. The goal will be to show
that (P ∨ Q) → R. The challenge is that P
∨ Q can be true because P is or because Q
is. So to show that R follows logically
from (P ∨ Q), we need to show that it
follows *in either case*. That is, we'd
need to show that P → R and Q → R. If both
cases are true, then R must be true no
matter why P ∨ Q is true (either because P
is or because R is).
-/

axioms
    (R : Prop)
    (p : P)
    (pr: P → R)
    (qr: Q → R)

example : (P ∨ Q) → R :=
λ (pq : P ∨ Q),
    -- case analysis on pq!!!
    match pq with
    | or.inl pfP := pr p
    | or.inr pfQ := qr q
    end

example : (P ∨ Q) → R :=
begin
assume pq,
cases pq with pfP pfQ,
apply pr pfP,
apply qr pfQ,
end

/-
Proof by negation. To prove ¬ P, assume P and
show that that assumption can be used to produce
a contradiction.
-/

example : ¬ false :=
λ (f : false), f

-- do this with a tactic script

example : ∀ (P : Prop), ¬ (P ∧ ¬ P) :=
λ (P : Prop),
    λ (h : P ∧ ¬ P),
        (h.right h.left)

-- do this with a tactic script

/-
Existential quantification!
-/

#print exists

example : ∃ (n : ℕ), n * n = 81 :=
    exists.intro 9 rfl

example : ∃ (n : ℕ), n * n = 81 :=
begin
    apply exists.intro _ _,
    exact 9,
    exact rfl,
end

-- let's make up another exercise

axiom Ball : Type
axiom isGreen : Ball → Prop
axiom isBlue : Ball → Prop

example :
    (∃ (b : Ball), isGreen b ∧ isBlue b) →
    ∃ (b : Ball), isGreen b :=
begin
assume h,
cases h with w pf,
apply exists.intro w _,
exact pf.left,
end

axiom Person : Type
axiom Likes : Person → Person → Prop

example :
    (∃ (p : Person), ∀ (q : Person), Likes q p) →
    (∀ (x : Person), ∃ (y : Person), Likes x y )
    :=
λ h,
    λ p,
        match h with
        | (exists.intro w pf) :=
           exists.intro w (pf p)
        end

example :
    (∃ (p : Person), ∀ (q : Person), Likes q p) →
    (∀ (x : Person), ∃ (y : Person), Likes x y )
    :=
begin
assume h,
assume p,
cases h with w pf,
exact exists.intro w (pf p)
end

def even : nat → Prop
| n := n % 2 = 0

example : exists (n : nat), even n :=
_

example : exists (n : nat), even n :=
begin
apply exists.intro 2 _,
unfold even,
exact eq.refl 0,
end

example : ∀ (n : ℕ), n = 0 ∨ n ≠ 0 :=
λ n,
    match n with
    | nat.zero := or.inl (eq.refl 0)
    | (nat.succ n') := or.inr
    (λ h,
    match h with
    end)
    end

axiom Person : Type
axiom Likes : Person → Person → Prop

example :
    (∃ (p : Person), ∀ (q : Person), Likes q p)  →
    (∀ (p : Person), ∃ (q : Person), Likes p q)
    :=
begin
assume (h : (∃ (p : Person), ∀ (q : Person), Likes q p)),
assume (p : Person),
cases h with w pf,
apply exists.intro w (pf p),
end

example :
    (∃ (p : Person), ∀ (q : Person), Likes q p)  →
    (∀ (p : Person), ∃ (q : Person), Likes p q)
    :=
λ (h : (∃ (p : Person), ∀ (q : Person), Likes q p)),
    λ (p : Person),
        match h with
        | exists.intro w pf := exists.intro w (pf p)
        end

-- cases is implemented by pattern matching!
-- By destructuring h and giving names to its parts.
-- I.e., h must be of the form (exists.intro w pf).
-- Giving names to the parts enables us now to
-- construct the proof of the conclusion by
-- using exists.intro applied to w, and to a
-- proof about w built by applying pf to w.

-- Short version!
example :
    (∃ (p : Person), ∀ (q : Person), Likes q p)  →
    (∀ (p : Person), ∃ (q : Person), Likes p q)
    :=
λ h p,
    match h with
    | exists.intro w pf :=
        exists.intro w (pf p)
    end

example : ∀ (b : bool), bor b tt = tt :=
begin
assume b,
cases b with T F,
apply eq.refl tt,
apply eq.refl tt,
end

example : ∀ (n : ℕ), n = 0 ∨ n ≠ 0 :=
begin
assume (n : ℕ),
cases n,
apply or.inl (eq.refl 0),
apply or.inr _,
assume h,
cases h,
end

example : ∀ (n : ℕ), n = 0 ∨ n ≠ 0 :=
λ n,
match n with
| nat.zero := or.inl (eq.refl 0)
| (nat.succ n') := or.inr (
    λ h,
        match h with
        end
)
 end

axiom Rel : Person → Person → Prop

example:
    symmetric Rel →
    ∀ (p1 p2 : Person), Rel p1 p2 → Rel p2 p1 :=
begin
assume h,
intros p1 p2,
assume r,
unfold symmetric at h,
exact (h r),
end

example :   (¬ ∃ (p : Person), ∀ (q : Person), ¬ Likes p q) →
            (∀ (p : Person), ∃ (q : Person), Likes p q) :=
begin
assume h,
intro p,
apply exists.intro p _,
end

∧
∨
¬
→
↔
∀